From 1bf4b042bafa88e9a2103ed37591caa46e6d33ab Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 10 May 2023 17:30:13 +0200 Subject: [PATCH 01/26] ocp-indent-compat: Align module arguments --- lib/Fmt_ast.ml | 3 ++- lib/Params.ml | 5 +++-- lib/Params.mli | 4 +++- test/passing/tests/js_source.ml.ref | 28 ++++++++++++++-------------- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 47ebe3ccd6..0dddafe2da 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3678,7 +3678,8 @@ and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword fmt_name_and_mt ~pro ~loc name mt else let bdy, epi = fmt_name_and_mt ~pro:noop ~loc name mt in - (pro $ hvbox 0 bdy $ epi, noop) + let bdy_indent = if args_p.align then 1 else 0 in + (pro $ hvbox bdy_indent bdy $ epi, noop) in let rec fmt_args ~pro = function | [] -> pro diff --git a/lib/Params.ml b/lib/Params.ml index bc7aa2bb9d..c05afb9d79 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -80,7 +80,7 @@ module Exp = struct end module Mod = struct - type args = {dock: bool; arg_psp: Fmt.t; indent: int} + type args = {dock: bool; arg_psp: Fmt.t; indent: int; align: bool} let arg_is_sig arg = match arg.txt with @@ -101,7 +101,8 @@ module Mod = struct else List.for_all ~f:arg_is_sig args in let arg_psp = if dock then str " " else break 1 psp_indent in - {dock; arg_psp; indent} + let align = ocp c in + {dock; arg_psp; indent; align} end let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t) diff --git a/lib/Params.mli b/lib/Params.mli index 4fa118f61f..0f7f31d1de 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -41,7 +41,9 @@ module Mod : sig type args = { dock: bool (** Whether each argument's [pro] should be docked. *) ; arg_psp: Fmt.t (** Break before every arguments. *) - ; indent: int } + ; indent: int + ; align: bool + (** Whether to align argument types inside their parenthesis. *) } val get_args : Conf.t -> functor_parameter loc list -> args end diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index a3b41cc805..f00881f080 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -2607,11 +2607,11 @@ type (_, _) t = module M (A : sig - module type T - end) + module type T + end) (B : sig - module type T - end) = + module type T + end) = struct let f : ((module A.T), (module B.T)) t -> string = function | B s -> s @@ -4745,8 +4745,8 @@ let flag = ref false module F (S : sig - module type T - end) + module type T + end) (A : S.T) (B : S.T) = struct @@ -4993,11 +4993,11 @@ let _ = f (module A_alias) (* doesn't type either *) module Foo (Bar : sig - type a = private [> `A ] - end) + type a = private [> `A ] + end) (Baz : module type of struct - include Bar - end) = + include Bar + end) = struct end module Bazoinks = struct @@ -5597,11 +5597,11 @@ end module F (Y : sig - type t - end) + type t + end) (M : sig - type t = Y.t - end) = + type t = Y.t + end) = struct end module G = F (M.Y) From 2e50162a8060b0704c778a41320ace987a959846 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 10 May 2023 18:18:01 +0200 Subject: [PATCH 02/26] Update CHANGES --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 9aeb658baa..5d5d4f1c20 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -27,7 +27,7 @@ - Restore short form for first-class modules: `((module M) : (module S))` is formatted as `(module M : S)`) (#2280, #2300, @gpetiot, @Julow) - Restore short form formatting of record field aliases (#2282, @gpetiot) -- Tweaks the JaneStreet profile to be more consistent with ocp-indent (#2214, #2281, #2284, #2289, #2299, #2302, #2309, #2310, #2311, #2313, #2316, @gpetiot, @Julow) +- Tweaks the JaneStreet profile to be more consistent with ocp-indent (#2214, #2281, #2284, #2289, #2299, #2302, #2309, #2310, #2311, #2313, #2316, #2363, @gpetiot, @Julow) - Improve formatting of class signatures (#2301, @gpetiot, @Julow) - JaneStreet profile: treat comments as doc-comments (#2261, #2344, #2354, @gpetiot, @Julow) - Don't indent attributes after a let/val/external (#2317, @Julow) From d5a4f3708992d6bd46a8f7f312f4eaaef4c4ec87 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 15 May 2023 13:35:14 +0200 Subject: [PATCH 03/26] WIP --- lib/Fmt_ast.ml | 221 ++++++---------- test/passing/tests/break_struct.ml.ref | 6 +- test/passing/tests/generative.ml.ref | 2 +- test/passing/tests/hash_types.ml | 5 +- test/passing/tests/injectivity.ml | 15 +- .../tests/let_binding-in_indent.ml.ref | 240 +----------------- test/passing/tests/let_binding-indent.ml.ref | 240 +----------------- test/passing/tests/let_binding.ml | 230 ----------------- test/passing/tests/let_binding.ml.ref | 240 +----------------- test/passing/tests/let_module-sparse.ml.ref | 2 +- test/passing/tests/let_module.ml.ref | 2 +- test/passing/tests/module.ml | 12 +- test/passing/tests/wrapping_functor_args.ml | 36 ++- .../tests/wrapping_functor_args.ml.err | 3 + 14 files changed, 117 insertions(+), 1137 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index e477d8eb6d..ac1ffdfdd1 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3408,108 +3408,63 @@ and fmt_functor_param c ctx {loc; txt= arg} = (wrap "(" ")" (hovbox 0 ( hovbox 0 (fmt_str_loc_opt c name $ fmt "@ : ") - $ compose_module (fmt_module_type c xmt) ~f:Fn.id ) ) ) + $ (fmt_module_type c xmt) ) ) ) -and fmt_module_type c ?(rec_ = false) ({ast= mty; _} as xmty) = +and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = let ctx = Mty mty in let {pmty_desc; pmty_loc; pmty_attributes} = mty in - update_config_maybe_disabled_block c pmty_loc pmty_attributes + update_config_maybe_disabled c pmty_loc pmty_attributes @@ fun c -> - let parens = - parenze_mty xmty - || match pmty_desc with Pmty_with _ when rec_ -> true | _ -> false - in + let parens = parenze_mty xmty in + let pro = fmt_opt pro $ fmt_if parens "(" $ Cmts.fmt_before c pmty_loc + and epi ~attr = Cmts.fmt_after ~pro:(str " ") c pmty_loc $ fmt_if parens ")" $ fmt_if_k attr (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) $ fmt_opt epi in match pmty_desc with - | Pmty_ident lid -> - { empty with - bdy= fmt_longident_loc c lid - ; epi= Some (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) } + | Pmty_ident lid -> pro $ fmt_longident_loc c lid $ epi ~attr:true | Pmty_signature s -> let empty = List.is_empty s && not (Cmts.has_within c.cmts pmty_loc) in - let before = Cmts.fmt_before c pmty_loc in - let within = Cmts.fmt_within c ~pro:noop pmty_loc in - let after = Cmts.fmt_after c pmty_loc in - { opn= None - ; pro= Some (before $ str "sig" $ fmt_if empty " ") - ; psp= fmt_if (not empty) "@;<1000 2>" - ; bdy= within $ fmt_signature c ctx s - ; cls= noop - ; esp= fmt_if (not empty) "@;<1000 0>" - ; epi= - Some - ( str "end" $ after - $ fmt_attributes_and_docstrings c pmty_attributes ) } + hvbox_if box 2 ( + pro $ + str "sig" + $ (if empty then str " " else break 1000 0 ) + $ Cmts.fmt_within c pmty_loc + $ fmt_signature c ctx s + $ (if empty then noop else break 1000 ~-2 ) + $ str "end" + $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false + ) | Pmty_functor (args, mt) -> - let blk = fmt_module_type c (sub_mty ~ctx mt) in - { blk with - pro= - Some - ( Cmts.fmt_before c pmty_loc - $ str "functor" + let pro = + pro + $ hvbox 2 (str "functor" $ fmt_attributes c ~pre:Blank pmty_attributes - $ fmt "@;<1 2>" - $ list args "@;<1 2>" (fmt_functor_param c ctx) - $ fmt "@;<1 2>->" - $ opt blk.pro (fun pro -> str " " $ pro) ) - ; epi= Some (fmt_opt blk.epi $ Cmts.fmt_after c pmty_loc) - ; psp= - fmt_or_k (Option.is_none blk.pro) - (fits_breaks " " ~hint:(1, 2) "") - blk.psp } + $ fmt "@ " + $ list args "@ " (fmt_functor_param c ctx)) + $ fmt " ->@ " + in + hvbox_if box 2 (fmt_module_type c ~pro (sub_mty ~ctx mt) $ epi ~attr:false) | Pmty_with _ -> let wcs, mt = Sugar.mod_with (sub_mty ~ctx mty) in let fmt_cstr ~first ~last:_ wc = let pre = if first then "with" else " and" in - fmt_or first "@ " "@," $ fmt_with_constraint c ctx ~pre wc + fmt_if (not first) "@," $ fmt_with_constraint c ctx ~pre wc in let fmt_cstrs ~first:_ ~last:_ (wcs_and, loc, attr) = - Cmts.fmt c loc + fmt "@ " $ hvbox 0 (Cmts.fmt c loc ( list_fl wcs_and fmt_cstr - $ fmt_attributes c ~pre:(Break (1, -1)) attr ) - in - let {pro; psp; bdy; esp; epi; opn= _; cls= _} = fmt_module_type c mt in - { empty with - pro= - Option.map pro ~f:(fun pro -> - open_hvbox 0 $ fmt_if parens "(" $ pro ) - ; psp - ; bdy= - fmt_if_k (Option.is_none pro) (open_hvbox 2 $ fmt_if parens "(") - $ hvbox 0 bdy - $ fmt_if_k (Option.is_some epi) esp - $ fmt_opt epi $ list_fl wcs fmt_cstrs $ fmt_if parens ")" - $ close_box - ; esp= fmt_if_k (Option.is_none epi) esp - ; epi= Some (Cmts.fmt_after c pmty_loc) } - | Pmty_typeof me -> ( - let blk = fmt_module_expr c (sub_mod ~ctx me) in - let epi = - fmt_opt blk.epi $ Cmts.fmt_after c pmty_loc $ fmt_if parens ")" - $ fmt_attributes c pmty_attributes ~pre:(Break (1, 0)) + $ fmt_attributes c ~pre:(Break (1, -1)) attr )) in - match blk.pro with - | Some pro -> - { blk with - pro= - Some - ( Cmts.fmt_before c pmty_loc - $ fmt_if parens "(" $ str "module type of " $ pro ) - ; epi= Some epi } - | _ -> - { blk with - bdy= - Cmts.fmt c pmty_loc - @@ hvbox 2 - (fmt_if parens "(" $ fmt "module type of@ " $ blk.bdy) - ; epi= Some epi } ) + hovbox_if box 2 ( + fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs + $ epi ~attr:true + ) + | Pmty_typeof me -> + let pro = pro $ fmt "module type of@ " in + let me_blk = fmt_module_expr c (sub_mod ~ctx me) in + hvbox_if box 2 (compose_module ~pro me_blk ~f:Fn.id $ epi ~attr:true) | Pmty_extension ext -> - { empty with - bdy= fmt_extension c ctx ext - ; epi= Some (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) } + pro $ fmt_extension c ctx ext $ epi ~attr:true | Pmty_alias lid -> - { empty with - bdy= fmt_longident_loc c lid - ; epi= Some (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) } + pro $ fmt_longident_loc c lid $ epi ~attr:true and fmt_signature c ctx itms = let update_config c i = @@ -3555,25 +3510,11 @@ and fmt_signature_item c ?ext {ast= si; _} = let force_before = not (Mty.is_simple pincl_mod) in fmt_docstring_around_item c ~force_before ~fit:true pincl_attributes in - let keyword, ({pro; psp; bdy; esp; epi; _} as blk) = - let kwd = str "include" $ fmt_extension_suffix c ext in - match pincl_mod with - | {pmty_desc= Pmty_typeof me; pmty_loc; pmty_attributes= _} -> - ( kwd - $ Cmts.fmt c ~pro:(str " ") ~epi:noop pmty_loc - (fmt "@ module type of") - , fmt_module_expr c (sub_mod ~ctx me) ) - | _ -> (kwd, fmt_module_type c (sub_mty ~ctx pincl_mod)) - in - let box = blk_box blk in + let pro = str "include" $ fmt_extension_suffix c ext in hvbox 0 ( doc_before - $ hvbox 0 - ( box - ( hvbox 2 (keyword $ opt pro (fun pro -> str " " $ pro)) - $ fmt_or_k (Option.is_some pro) psp (fmt "@;<1 2>") - $ bdy ) - $ esp $ fmt_opt epi + $ hvbox 0 ( + fmt_module_type ~pro c (sub_mty ~ctx pincl_mod) $ fmt_item_attributes c ~pre:(Break (1, 0)) atrs ) $ doc_after ) | Psig_modtype mtd -> fmt_module_type_declaration ?ext c ctx mtd @@ -3667,48 +3608,29 @@ and fmt_class_exprs ?ext c ctx cls = $ hovbox 0 @@ Cmts.fmt c cl.pci_loc (doc_before $ class_exprs $ doc_after) ) -and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword +and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") name xargs xbody xmty attributes ~rec_flag = - let blk_t = - Option.value_map xmty ~default:empty ~f:(fun xmty -> - let blk = fmt_module_type ?rec_ c xmty in - { blk with - pro= - Some (str " " $ str eqty $ opt blk.pro (fun pro -> str " " $ pro)) - ; psp= fmt_if (Option.is_none blk.pro) "@;<1 2>" $ blk.psp } ) - in let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in - let fmt_name_and_mt ~pro ~loc name mt = - let xmt = sub_mty ~ctx mt in - let blk = fmt_module_type c ?rec_ xmt in + let fmt_name_and_mt ~box ~pro ~loc name mt = let pro = pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name $ str " : " and epi = str ")" $ Cmts.fmt_after c loc in - compose_module' ~box:false ~pro ~epi blk + fmt_module_type ~box ~pro ~epi c (sub_mty ~ctx mt) in let args_p = Params.Mod.get_args c.conf xargs in (* Carry the [epi] to be placed in the next argument's box. *) - let fmt_arg ~pro {loc; txt} = + let fmt_arg ~box ~pro {loc; txt} = let pro = pro $ args_p.arg_psp in match txt with - | Unit -> - (pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)), noop) + | Unit -> pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) | Named (name, mt) -> - if args_p.dock then - (* All signatures, put the [epi] into the box of the next arg and - don't break. *) - fmt_name_and_mt ~pro ~loc name mt - else - let bdy, epi = fmt_name_and_mt ~pro:noop ~loc name mt in - let bdy_indent = if args_p.align then 1 else 0 in - (pro $ hvbox bdy_indent bdy $ epi, noop) + let outer_box, box = if args_p.align then hvbox 1, false else Fn.id, box in + outer_box (fmt_name_and_mt ~box ~pro ~loc name mt) in - let rec fmt_args ~pro = function + let rec fmt_args ~box ~pro = function | [] -> pro - | hd :: tl -> - let bdy, epi = fmt_arg ~pro hd in - bdy $ fmt_args ~pro:epi tl + | hd :: tl -> fmt_arg ~box ~pro hd $ fmt_args ~box ~pro:noop tl in let intro = str keyword @@ -3728,17 +3650,33 @@ and fmt_module c ctx ?rec_ ?ext ?epi ?(can_sparse = false) keyword fmt_docstring_around_item c ~force_before:(not single_line) ~fit:true attributes in + + let fmt_mty = + let args = + (* All signatures, put the [epi] into the box of the next arg and + don't break. *) + if args_p.dock then + hovbox 4 ( + fmt_args ~box:false ~pro:intro xargs + ) + else + fmt_args ~box:true ~pro:intro xargs + in + hvbox args_p.indent ( + match xmty with + | Some xmty -> + let pro = args $ str " " $ str eqty $ str " " in + fmt_module_type ~pro c xmty + | None -> args + ) + in + hvbox (if compact then 0 else 2) ( doc_before $ blk_box blk_b - ( (if Option.is_some blk_t.epi then hovbox else hvbox) - 0 - ( blk_box blk_t - ( hvbox args_p.indent - (fmt_args ~pro:intro xargs $ fmt_opt blk_t.pro) - $ blk_t.psp $ blk_t.bdy ) - $ blk_t.esp $ fmt_opt blk_t.epi + ( hovbox 0 + ( fmt_mty $ fmt_if (Option.is_some xbody) " =" $ fmt_if_k compact fmt_pro ) $ fmt_if_k (not compact) fmt_pro @@ -3771,7 +3709,7 @@ and fmt_module_declaration ?ext c ~rec_flag ~first {ast= pmd; _} = match xmty.ast.pmty_desc with Pmty_alias _ -> None | _ -> Some ":" in Cmts.fmt c pmd_loc - (fmt_module ~rec_:rec_flag ?ext c ctx keyword pmd_name pmd_args None + (fmt_module ?ext c ctx keyword pmd_name pmd_args None ?eqty (Some xmty) ~rec_flag:(rec_flag && first) pmd_attributes ) and fmt_module_substitution ?ext c ctx pms = @@ -3964,11 +3902,10 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) = (`Block (blk_a, Mod.is_simple me_a)) | Pmod_constraint (me, mt) -> let blk_e = fmt_module_expr c (sub_mod ~ctx me) in - let blk_t = fmt_module_type c (sub_mty ~ctx mt) in let has_epi = Cmts.has_after c.cmts pmod_loc || not (List.is_empty pmod_attributes) in - { opn= Some (fmt_opt blk_t.opn $ fmt_opt blk_e.opn $ open_hovbox 2) + { opn= Some (fmt_opt blk_e.opn $ open_hovbox 2) ; pro= Some (Cmts.fmt_before c pmod_loc $ str "(") ; psp= fmt "@," ; bdy= @@ -3976,10 +3913,9 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) = ( fmt_opt blk_e.pro $ blk_e.psp $ blk_e.bdy $ blk_e.esp $ fmt_opt blk_e.epi $ fmt " :@;<1 2>" $ hvbox 0 - ( fmt_opt blk_t.pro $ blk_t.psp $ blk_t.bdy $ blk_t.esp - $ fmt_opt blk_t.epi ) ) + (fmt_module_type c (sub_mty ~ctx mt)) ) $ closing_paren c ~offset:(-2) - ; cls= close_box $ blk_e.cls $ blk_t.cls + ; cls= close_box $ blk_e.cls ; esp= noop ; epi= Option.some_if has_epi @@ -4339,7 +4275,7 @@ and fmt_module_binding ?ext c ~rec_flag ~first {ast= pmb; _} = | _ -> (xbody, None) in Cmts.fmt c pmb.pmb_loc - (fmt_module ~rec_:rec_flag ?ext c ctx keyword + (fmt_module ?ext c ctx keyword ~rec_flag:(rec_flag && first) ~eqty:":" pmb.pmb_name pmb.pmb_args (Some xbody) xmty pmb.pmb_attributes ) @@ -4458,7 +4394,6 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t) | Use_file, l -> Chunk.split_and_fmt Use_file c ctx l | Core_type, ty -> fmt_core_type c (sub_typ ~ctx:(Pld (PTyp ty)) ty) | Module_type, mty -> - compose_module ~f:Fn.id (fmt_module_type c (sub_mty ~ctx:(Mty mty) mty)) | Expression, e -> fmt_expression c (sub_exp ~ctx:(Str (Ast_helper.Str.eval e)) e) diff --git a/test/passing/tests/break_struct.ml.ref b/test/passing/tests/break_struct.ml.ref index 6424689ae2..a196ea246e 100644 --- a/test/passing/tests/break_struct.ml.ref +++ b/test/passing/tests/break_struct.ml.ref @@ -79,7 +79,5 @@ end include ( Ast_407 : - module type of struct - include Ast_407 - end - with module Location := Ast_407.Location ) + module type of struct include Ast_407 end + with module Location := Ast_407.Location ) diff --git a/test/passing/tests/generative.ml.ref b/test/passing/tests/generative.ml.ref index bd22c02221..700640fe35 100644 --- a/test/passing/tests/generative.ml.ref +++ b/test/passing/tests/generative.ml.ref @@ -9,7 +9,7 @@ module F2 : functor () () -> sig end = F1 module F2 : (*xx*) functor ( (*yy*) ) (*zz*) -> sig end = F1 -module F2 : functor () -> functor [@attr] () () -> sig end = F1 +module F2 : functor () -> (functor [@attr] () () -> sig end) = F1 module F2 : functor () () () () -> sig end = F1 diff --git a/test/passing/tests/hash_types.ml b/test/passing/tests/hash_types.ml index a2f551ab00..d6124f8653 100644 --- a/test/passing/tests/hash_types.ml +++ b/test/passing/tests/hash_types.ml @@ -1,7 +1,6 @@ module F (X : sig - type t -end) = -struct + type t + end) = struct class type ['a] c = object method m : 'a -> X.t end diff --git a/test/passing/tests/injectivity.ml b/test/passing/tests/injectivity.ml index ea909bba79..2a6173d8b1 100644 --- a/test/passing/tests/injectivity.ml +++ b/test/passing/tests/injectivity.ml @@ -59,23 +59,20 @@ end type !'a u = int constraint 'a = 'b t module F (X : sig - type 'a t -end) = -struct + type 'a t + end) = struct type !'a u = 'b constraint 'a = < b: 'b > constraint 'b = _ X.t end module F (X : sig - type 'a t -end) = -struct + type 'a t + end) = struct type !'a u = 'b X.t constraint 'a = < b: 'b X.t > end module F (X : sig - type 'a t -end) = -struct + type 'a t + end) = struct type !'a u = 'b constraint 'a = < b: (_ X.t as 'b) > end diff --git a/test/passing/tests/let_binding-in_indent.ml.ref b/test/passing/tests/let_binding-in_indent.ml.ref index 9d8a1b5bd6..8d594caeaa 100644 --- a/test/passing/tests/let_binding-in_indent.ml.ref +++ b/test/passing/tests/let_binding-in_indent.ml.ref @@ -1,242 +1,4 @@ -(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : - typ) = exp ]}. The difference should be maintained *) - -let (_ : int) = x1 - -let (x : int) = x2 - -let (_ : int) = x3 - -let x : int = x4 - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - () - -let%ext (_ : int) = x1 - -let%ext (x : int) = x2 - -let%ext (_ : int) = x3 - -let%ext x : int = x4 - -let%ext _ = - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let [%ext let x = 3] = 2 - -let [%ext: [%exp let x = 3]] = 2 - -let f : 'a. 'a ty -> 'a = fun y -> g y - -let f (A _ | B | C) = () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb - | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf - | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () - -let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () - -let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () - -let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> - () - -let (_ : t -> t -> int) = (compare : int list -> int list -> int) - -let _ = - let[@test] rec f = x in - y - -module Let_and_compact = struct - [@@@ocamlformat "let-and=compact"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 and y = 2 in - 3 - - let _ = - let%ext x = 2 and y = 2 in - 3 -end - -module Let_and_sparse = struct - [@@@ocamlformat "let-and=sparse"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 - and y = 2 in - 3 - - let _ = - let%ext x = 2 - and y = 2 in - 3 -end - -let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee = - () - -let _ = - fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee -> - () - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let fooo = fooooooooooo [@@foo] - -let fooo = fooooooooooo [@@foo] - -and fooo = fooooooooooo [@@foo] -;; - -let foooo = fooooooooo [@@foo] in - fooooooooooooooooooooo - -let[@foo] fooo = fooooooooooo - -let[@foo] fooo = fooooooooooo - -and[@foo] fooo = fooooooooooo -;; - -let[@foo] foooo = fooooooooo in - fooooooooooooooooooooo - -let a : int = 0 - -let b = (0 : int) - -let _ = - let+ a = b in - c - -let _ = - let+ a = b and+ c = d in - e - -let _ = - if true then a - else - let+ a = b in - c - -let _ = - if true then - let+ a = b in - c - else d - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) ) - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) - | b -> c ) - -let _ = - let+ a b = c in - d - -let _ = - f - (let+ a b = c in - d ) - -let () = - let* x = 1 (* blah *) and* y = 2 in - () - let x = () -(* after x *) - -let y = () - -let x = () -(* after x *) - -and y = () - -(** doc x *) -let x = () [@@foo] -(* after x *) (** doc y *) -let y = () [@@foo] -(* after y *) - -(** doc x *) -let x = () -(* after x *) - -(** doc y *) -and y = () [@@foo] -(* after y *) - -let _ = - let* () = - (* xxx *) - xxx - and* () = - (* yyy *) - yyy - in - zzz - -[@@@ocamlformat "let-binding-spacing=double-semicolon"] - -module A = struct - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> - match (l, r) with A, B -> "f A B" - ;; -end +and y = () diff --git a/test/passing/tests/let_binding-indent.ml.ref b/test/passing/tests/let_binding-indent.ml.ref index 577469e2ae..8d594caeaa 100644 --- a/test/passing/tests/let_binding-indent.ml.ref +++ b/test/passing/tests/let_binding-indent.ml.ref @@ -1,242 +1,4 @@ -(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : - typ) = exp ]}. The difference should be maintained *) - -let (_ : int) = x1 - -let (x : int) = x2 - -let (_ : int) = x3 - -let x : int = x4 - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - () - -let%ext (_ : int) = x1 - -let%ext (x : int) = x2 - -let%ext (_ : int) = x3 - -let%ext x : int = x4 - -let%ext _ = - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let [%ext let x = 3] = 2 - -let [%ext: [%exp let x = 3]] = 2 - -let f : 'a. 'a ty -> 'a = fun y -> g y - -let f (A _ | B | C) = () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb - | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf - | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () - -let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () - -let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () - -let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> - () - -let (_ : t -> t -> int) = (compare : int list -> int list -> int) - -let _ = - let[@test] rec f = x in - y - -module Let_and_compact = struct - [@@@ocamlformat "let-and=compact"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 and y = 2 in - 3 - - let _ = - let%ext x = 2 and y = 2 in - 3 -end - -module Let_and_sparse = struct - [@@@ocamlformat "let-and=sparse"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 - and y = 2 in - 3 - - let _ = - let%ext x = 2 - and y = 2 in - 3 -end - -let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee = - () - -let _ = - fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccc dddddddddddddddddd eeeeeeeeeeeeee -> - () - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let fooo = fooooooooooo [@@foo] - -let fooo = fooooooooooo [@@foo] - -and fooo = fooooooooooo [@@foo] -;; - -let foooo = fooooooooo [@@foo] in -fooooooooooooooooooooo - -let[@foo] fooo = fooooooooooo - -let[@foo] fooo = fooooooooooo - -and[@foo] fooo = fooooooooooo -;; - -let[@foo] foooo = fooooooooo in -fooooooooooooooooooooo - -let a : int = 0 - -let b = (0 : int) - -let _ = - let+ a = b in - c - -let _ = - let+ a = b and+ c = d in - e - -let _ = - if true then a - else - let+ a = b in - c - -let _ = - if true then - let+ a = b in - c - else d - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) ) - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) - | b -> c ) - -let _ = - let+ a b = c in - d - -let _ = - f - (let+ a b = c in - d ) - -let () = - let* x = 1 (* blah *) and* y = 2 in - () - let x = () -(* after x *) - -let y = () - -let x = () -(* after x *) - -and y = () - -(** doc x *) -let x = () [@@foo] -(* after x *) (** doc y *) -let y = () [@@foo] -(* after y *) - -(** doc x *) -let x = () -(* after x *) - -(** doc y *) -and y = () [@@foo] -(* after y *) - -let _ = - let* () = - (* xxx *) - xxx - and* () = - (* yyy *) - yyy - in - zzz - -[@@@ocamlformat "let-binding-spacing=double-semicolon"] - -module A = struct - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> - match (l, r) with A, B -> "f A B" - ;; -end +and y = () diff --git a/test/passing/tests/let_binding.ml b/test/passing/tests/let_binding.ml index e21a79764f..de9e5a7ab4 100644 --- a/test/passing/tests/let_binding.ml +++ b/test/passing/tests/let_binding.ml @@ -1,233 +1,3 @@ -(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : - typ) = exp ]}. The difference should be maintained *) - -let (_ : int) = x1 - -let (x : int) = x2 - -let (_ : int) = x3 - -let x : int = x4 - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let _ : int = x in - () - -let%ext (_ : int) = x1 - -let%ext (x : int) = x2 - -let%ext (_ : int) = x3 - -let%ext x : int = x4 - -let%ext _ = - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let [%ext let x = 3] = 2 - -let [%ext: [%exp let x = 3]] = 2 - -let f : 'a. 'a ty -> 'a = fun y -> g y - -let f (A _ | B | C) = () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb - | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf - | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () - -let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () - -let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () - -let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> - () - -let (_ : t -> t -> int) = (compare : int list -> int list -> int) - -let _ = - let[@test] rec f = x in - y - -module Let_and_compact = struct - [@@@ocamlformat "let-and=compact"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 and y = 2 in - 3 - - let _ = - let%ext x = 2 and y = 2 in - 3 -end - -module Let_and_sparse = struct - [@@@ocamlformat "let-and=sparse"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 - and y = 2 in - 3 - - let _ = - let%ext x = 2 - and y = 2 in - 3 -end - -let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb - cccccccccccccccccccccccc dddddddddddddddddd eeeeeeeeeeeeee = - () - -let _ = - fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee -> - () - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let _ : int = x in - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext _ : int = x in - () - -let fooo = fooooooooooo [@@foo];; - -let fooo = fooooooooooo [@@foo] -and fooo = fooooooooooo [@@foo];; - -let foooo = fooooooooo [@@foo] in -fooooooooooooooooooooo - -let [@foo] fooo = fooooooooooo;; - -let [@foo] fooo = fooooooooooo -and [@foo] fooo = fooooooooooo;; - -let [@foo] foooo = fooooooooo in -fooooooooooooooooooooo - -let a : int = 0 - -let b = (0 : int) - -let _ = - let+ a = b in - c - -let _ = - let+ a = b - and+ c = d in - e - -let _ = - if true then a - else let+ a = b in c - -let _ = - if true then let+ a = b in c - else d - -let _ = - match a with - | a -> - match a with - | a -> let+ a = b in match a with a -> a - -let _ = - match a with - | a -> - match a with - | a -> (let+ a = b in match a with a -> a) - | b -> c - -let _ = - let+ a b = c in - d - - -let _ = f (let+ a b = c in d) - -let () = - let* x = 1 (* blah *) and* y = 2 in - () - let x = () -(* after x *) - -let y = () - -let x = () -(* after x *) - -and y = () - -let x = () -[@@foo] -(* after x *) -(** doc x *) - -let y = () -[@@foo] -(* after y *) -(** doc y *) - -let x = () -(* after x *) -(** doc x *) - and y = () -[@@foo] -(* after y *) (** doc y *) - - -let _ = - let* () = - (* xxx *) - xxx - and* () = - (* yyy *) - yyy - in - zzz - -[@@@ocamlformat "let-binding-spacing=double-semicolon"] - -module A = struct - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> - match (l, r) with A, B -> "f A B" - ;; -end diff --git a/test/passing/tests/let_binding.ml.ref b/test/passing/tests/let_binding.ml.ref index b45a996b9a..8d594caeaa 100644 --- a/test/passing/tests/let_binding.ml.ref +++ b/test/passing/tests/let_binding.ml.ref @@ -1,242 +1,4 @@ -(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : - typ) = exp ]}. The difference should be maintained *) - -let (_ : int) = x1 - -let (x : int) = x2 - -let (_ : int) = x3 - -let x : int = x4 - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - () - -let%ext (_ : int) = x1 - -let%ext (x : int) = x2 - -let%ext (_ : int) = x3 - -let%ext x : int = x4 - -let%ext _ = - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let [%ext let x = 3] = 2 - -let [%ext: [%exp let x = 3]] = 2 - -let f : 'a. 'a ty -> 'a = fun y -> g y - -let f (A _ | B | C) = () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb - | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f - ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa - ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf - | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) - | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = - () - -let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () - -let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () - -let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () - -let f = function - | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG - |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> - () - -let (_ : t -> t -> int) = (compare : int list -> int list -> int) - -let _ = - let[@test] rec f = x in - y - -module Let_and_compact = struct - [@@@ocamlformat "let-and=compact"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 and y = 2 in - 3 - - let _ = - let%ext x = 2 and y = 2 in - 3 -end - -module Let_and_sparse = struct - [@@@ocamlformat "let-and=sparse"] - - let x = 2 - - and y = 2 - - let _ = - let x = 2 - and y = 2 in - 3 - - let _ = - let%ext x = 2 - and y = 2 in - 3 -end - -let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee = - () - -let _ = - fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc - dddddddddddddddddd eeeeeeeeeeeeee -> - () - -let _ = - let (x : int) = x in - let x : int = x in - let (_ : int) = x in - let (_ : int) = x in - let%ext (x : int) = x in - let%ext x : int = x in - let%ext (_ : int) = x in - let%ext (_ : int) = x in - () - -let fooo = fooooooooooo [@@foo] - -let fooo = fooooooooooo [@@foo] - -and fooo = fooooooooooo [@@foo] -;; - -let foooo = fooooooooo [@@foo] in -fooooooooooooooooooooo - -let[@foo] fooo = fooooooooooo - -let[@foo] fooo = fooooooooooo - -and[@foo] fooo = fooooooooooo -;; - -let[@foo] foooo = fooooooooo in -fooooooooooooooooooooo - -let a : int = 0 - -let b = (0 : int) - -let _ = - let+ a = b in - c - -let _ = - let+ a = b and+ c = d in - e - -let _ = - if true then a - else - let+ a = b in - c - -let _ = - if true then - let+ a = b in - c - else d - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) ) - -let _ = - match a with - | a -> ( - match a with - | a -> ( - let+ a = b in - match a with a -> a ) - | b -> c ) - -let _ = - let+ a b = c in - d - -let _ = - f - (let+ a b = c in - d ) - -let () = - let* x = 1 (* blah *) and* y = 2 in - () - let x = () -(* after x *) - -let y = () - -let x = () -(* after x *) - -and y = () - -(** doc x *) -let x = () [@@foo] -(* after x *) (** doc y *) -let y = () [@@foo] -(* after y *) - -(** doc x *) -let x = () -(* after x *) - -(** doc y *) -and y = () [@@foo] -(* after y *) - -let _ = - let* () = - (* xxx *) - xxx - and* () = - (* yyy *) - yyy - in - zzz - -[@@@ocamlformat "let-binding-spacing=double-semicolon"] - -module A = struct - let f : int S.t ab -> float S.t ab -> string = - fun (l : int S.t ab) (r : float S.t ab) -> - match (l, r) with A, B -> "f A B" - ;; -end +and y = () diff --git a/test/passing/tests/let_module-sparse.ml.ref b/test/passing/tests/let_module-sparse.ml.ref index 66a42f904a..976d5928e6 100644 --- a/test/passing/tests/let_module-sparse.ml.ref +++ b/test/passing/tests/let_module-sparse.ml.ref @@ -57,5 +57,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/let_module.ml.ref b/test/passing/tests/let_module.ml.ref index e484db2ded..9b100468d7 100644 --- a/test/passing/tests/let_module.ml.ref +++ b/test/passing/tests/let_module.ml.ref @@ -49,5 +49,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/module.ml b/test/passing/tests/module.ml index 778a4ff22b..30d31ef6f5 100644 --- a/test/passing/tests/module.ml +++ b/test/passing/tests/module.ml @@ -31,16 +31,13 @@ end module O : sig type t -end -with type t := t = struct +end with type t := t = struct let () = () end module O : sig type t -end -with type t := t - and type s := s = struct +end with type t := t and type s := s = struct let () = () end @@ -56,10 +53,9 @@ let x : (module S) = (module struct end) let x = (module struct end : S) -module rec A : (sig +module rec A : sig type t -end -with type t = int) = struct +end with type t = int = struct type t = int end diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 276274dbab..9942efe72f 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -12,29 +12,25 @@ module OauthClient = (Sociaml_oauth_client.Posix.MAC_SHA1) (Sociaml_oauth_client.Posix.Random) -module F1 - (G : functor (_ : T) -> T) - (A : sig - val x : int - end) = -struct end +module F1 (G : functor (_ : T) -> T) + (A : sig + val x : int + end) = struct end module F2 - (G : functor - (_ : T) - -> - T_________________________________________________________________________) - (A : sig - val x : int - end) = + (G : functor (_ : T) -> + T_________________________________________________________________________) + (A : sig + val x : + int + end) = struct end module F3 - (G : functor - (_ : T____________________________________________) - (_ : T____________________________________________) - -> T) - (A : sig + (G : functor + (_ : T____________________________________________) + (_ : T____________________________________________) -> + T) + (A : sig val x : int - end) = -struct end + end) = struct end diff --git a/test/passing/tests/wrapping_functor_args.ml.err b/test/passing/tests/wrapping_functor_args.ml.err index 6ccd438d50..a04e36e0f0 100644 --- a/test/passing/tests/wrapping_functor_args.ml.err +++ b/test/passing/tests/wrapping_functor_args.ml.err @@ -1 +1,4 @@ +Warning: tests/wrapping_functor_args.ml:22 exceeds the margin +Warning: tests/wrapping_functor_args.ml:23 exceeds the margin +Warning: tests/wrapping_functor_args.ml:24 exceeds the margin Warning: tests/wrapping_functor_args.ml:25 exceeds the margin From f3f887f21be668bede701937296b50e235596b47 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Mon, 22 May 2023 16:35:08 +0200 Subject: [PATCH 04/26] Fix formatting of includes, pmod_with, functor --- lib/Ast.ml | 5 +- lib/Fmt_ast.ml | 18 ++++--- test/passing/tests/attributes.ml | 13 +++-- test/passing/tests/attributes.ml.err | 2 +- test/passing/tests/doc_comments-after.ml.ref | 18 +++---- .../doc_comments-before-except-val.ml.ref | 18 +++---- test/passing/tests/doc_comments-before.ml.ref | 18 +++---- test/passing/tests/doc_comments.ml.ref | 18 +++---- test/passing/tests/functor.ml | 49 ++++++++++++------- test/passing/tests/functor.ml.err | 11 +++++ test/passing/tests/mod_type_subst.ml | 32 ++++++------ test/passing/tests/module_attributes.ml.ref | 13 ++--- test/passing/tests/shortcut_ext_attr.ml | 10 ++-- test/passing/tests/wrapping_functor_args.ml | 32 +----------- .../tests/wrapping_functor_args.ml.err | 4 -- 15 files changed, 125 insertions(+), 136 deletions(-) create mode 100644 test/passing/tests/functor.ml.err diff --git a/lib/Ast.ml b/lib/Ast.ml index 3f50ec184f..ed981e54ca 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -1788,7 +1788,10 @@ end = struct (** [parenze_mty {ctx; ast}] holds when module type [ast] should be parenthesized in context [ctx]. *) - let parenze_mty {ctx= _; ast= mty} = Mty.has_trailing_attributes mty + let parenze_mty {ctx=_; ast= mty} = + match mty.pmty_desc with + | Pmty_ident _ | Pmty_extension _ -> false + | _ -> Mty.has_trailing_attributes mty (** [parenze_mod {ctx; ast}] holds when module expr [ast] should be parenthesized in context [ctx]. *) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index ac1ffdfdd1..04a9e7da5b 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3434,12 +3434,14 @@ and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = ) | Pmty_functor (args, mt) -> let pro = - pro - $ hvbox 2 (str "functor" - $ fmt_attributes c ~pre:Blank pmty_attributes - $ fmt "@ " - $ list args "@ " (fmt_functor_param c ctx)) - $ fmt " ->@ " + hvbox 2 ( + pro $ str "functor" + $ fmt_attributes c ~pre:Blank pmty_attributes + $ fmt "@ " + $ list args "@ " (fmt_functor_param c ctx) + $ fmt " ->" + ) + $ fmt "@ " in hvbox_if box 2 (fmt_module_type c ~pro (sub_mty ~ctx mt) $ epi ~attr:false) | Pmty_with _ -> @@ -3455,7 +3457,7 @@ and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = in hovbox_if box 2 ( fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs - $ epi ~attr:true + $ epi ~attr:false (* Handled by [Sugar.mod_with]. *) ) | Pmty_typeof me -> let pro = pro $ fmt "module type of@ " in @@ -3510,7 +3512,7 @@ and fmt_signature_item c ?ext {ast= si; _} = let force_before = not (Mty.is_simple pincl_mod) in fmt_docstring_around_item c ~force_before ~fit:true pincl_attributes in - let pro = str "include" $ fmt_extension_suffix c ext in + let pro = str "include" $ fmt_extension_suffix c ext $ str " " in hvbox 0 ( doc_before $ hvbox 0 ( diff --git a/test/passing/tests/attributes.ml b/test/passing/tests/attributes.ml index d37d0b8be8..34994374fc 100644 --- a/test/passing/tests/attributes.ml +++ b/test/passing/tests/attributes.ml @@ -51,13 +51,12 @@ module type M = sig module T : (S with type t = (r[@test3]) [@test4]) - module T : - (S - with type t = t - and type u := u - and module R = R - and module S := S - [@test]) + module T : (S + with type t = t + and type u := u + and module R = R + and module S := S + [@test]) module T : module type of X [@test5] diff --git a/test/passing/tests/attributes.ml.err b/test/passing/tests/attributes.ml.err index 5d08534f53..275347abc5 100644 --- a/test/passing/tests/attributes.ml.err +++ b/test/passing/tests/attributes.ml.err @@ -1 +1 @@ -Warning: tests/attributes.ml:339 exceeds the margin +Warning: tests/attributes.ml:338 exceeds the margin diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index fdacc13e71..bf898bc834 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S module Gen () : S (** Generative functor *) diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 59a6180c19..90fa3537a7 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index efa518581f..5855851529 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 59a6180c19..90fa3537a7 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml index 52d911a6b0..2d4650c6e5 100644 --- a/test/passing/tests/functor.ml +++ b/test/passing/tests/functor.ml @@ -14,8 +14,8 @@ module type M = functor (S : S) () -> sig end module type M = functor (SSSSS : SSSSSSSSSSSSSS) - (TTTTT : TTTTTTTTTTTTTTTT) - -> sig + (TTTTT : TTTTTTTTTTTTTTTT) -> + sig val t1 : a val t2 : b @@ -60,24 +60,37 @@ module type Module_type_fail = sig include S end -module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> - S - with type key = string list - and type step = string - and type contents = C.t - and type branch = string - and module Git = G +module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> S + with type key = string list + and type step = string + and type contents = C.t + and type branch = string + and module Git = G module Make - (TT : TableFormat.TABLES) - (IT : InspectionTableFormat.TABLES with type 'a lr1state = int) - (ET : EngineTypes.TABLE - with type terminal = int - and type nonterminal = int - and type semantic_value = Obj.t) - (E : sig - type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env - end) = + (TT : TableFormat.TABLES) (IT : InspectionTableFormat.TABLES + with type 'a lr1state = int) + (ET : EngineTypes + .TABLE + with type terminal = + int + and type nonterminal = + int + and type semantic_value = + Obj.t) + (E : sig + type 'a + env = + ( ET + .state + , ET + .semantic_value + , ET + .token + ) + EngineTypes + .env + end) = struct type t = t end diff --git a/test/passing/tests/functor.ml.err b/test/passing/tests/functor.ml.err new file mode 100644 index 0000000000..8c280bc319 --- /dev/null +++ b/test/passing/tests/functor.ml.err @@ -0,0 +1,11 @@ +Warning: tests/functor.ml:72 exceeds the margin +Warning: tests/functor.ml:74 exceeds the margin +Warning: tests/functor.ml:76 exceeds the margin +Warning: tests/functor.ml:78 exceeds the margin +Warning: tests/functor.ml:80 exceeds the margin +Warning: tests/functor.ml:81 exceeds the margin +Warning: tests/functor.ml:82 exceeds the margin +Warning: tests/functor.ml:84 exceeds the margin +Warning: tests/functor.ml:86 exceeds the margin +Warning: tests/functor.ml:88 exceeds the margin +Warning: tests/functor.ml:90 exceeds the margin diff --git a/test/passing/tests/mod_type_subst.ml b/test/passing/tests/mod_type_subst.ml index 7114c58323..1b116a3149 100644 --- a/test/passing/tests/mod_type_subst.ml +++ b/test/passing/tests/mod_type_subst.ml @@ -13,19 +13,17 @@ module type t' = t with module type x = x module type t'' = t with module type x := x -module type t3 = - t - with - module type x = sig - type t - end - -module type t4 = - t - with - module type x := sig - type t - end +module type t3 = t + with + module type x = sig + type t + end + +module type t4 = t + with + module type x := sig + type t + end (** nested *) @@ -83,11 +81,11 @@ module type u = sig module M : t end -module type r = - u with type x = int and type y = float and module type t = base +module type r = u + with type x = int and type y = float and module type t = base -module type r = - u with type x = int and type y = float and module type t := base +module type r = u + with type x = int and type y = float and module type t := base (** First class module types require an identity *) diff --git a/test/passing/tests/module_attributes.ml.ref b/test/passing/tests/module_attributes.ml.ref index 11cac6e12c..839c4050d8 100644 --- a/test/passing/tests/module_attributes.ml.ref +++ b/test/passing/tests/module_attributes.ml.ref @@ -24,19 +24,14 @@ include ( include ( List : - (module type of Foo - with module A := A - [@warning "-3"] [@warning "-3"] - with module B := B - [@warning "-3"]) ) + (module type of Foo with module A := A [@warning "-3"] [@warning "-3"] + with module B := B [@warning "-3"]) ) include ( List : (module type of Pervasives - with module A := A - [@warning "-3"] [@warning "-3"] - with module B := B - [@warning "-3"] [@warning "-3"]) ) + with module A := A [@warning "-3"] [@warning "-3"] + with module B := B [@warning "-3"] [@warning "-3"]) ) [@warning "-3"] module My_module_name : sig end = struct end diff --git a/test/passing/tests/shortcut_ext_attr.ml b/test/passing/tests/shortcut_ext_attr.ml index ba22919dad..e020a02644 100644 --- a/test/passing/tests/shortcut_ext_attr.ml +++ b/test/passing/tests/shortcut_ext_attr.ml @@ -78,11 +78,11 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo1] - (M : S) - -> functor - (_ : (module type of M) [@foo2]) - -> sig end [@foo3] +module type S = (functor [@foo1] (M : S) -> + functor + (_ : (module type of M) [@foo2]) -> + (sig end + [@foo3])) (* Structure items *) let%foo[@foo] x = 4 diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 9942efe72f..dcf8c9ae04 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -1,35 +1,7 @@ -(* This declaration looks odd *) -type request_token = - Sociaml_oauth_client.Client.Make(Sociaml_oauth_client.Posix.Clock) - (Sociaml_oauth_client.Posix.MAC_SHA1) - (Sociaml_oauth_client.Posix.Random) - .request_token - -(* Whereas this one works well *) -module OauthClient = - Sociaml_oauth_client.Client.Make - (Sociaml_oauth_client.Posix.Clock) - (Sociaml_oauth_client.Posix.MAC_SHA1) - (Sociaml_oauth_client.Posix.Random) - -module F1 (G : functor (_ : T) -> T) - (A : sig - val x : int - end) = struct end - -module F2 - (G : functor (_ : T) -> - T_________________________________________________________________________) - (A : sig - val x : - int - end) = -struct end - module F3 (G : functor - (_ : T____________________________________________) - (_ : T____________________________________________) -> + (_ : T____________________________________________) + (_ : T____________________________________________) -> T) (A : sig val x : int diff --git a/test/passing/tests/wrapping_functor_args.ml.err b/test/passing/tests/wrapping_functor_args.ml.err index a04e36e0f0..e69de29bb2 100644 --- a/test/passing/tests/wrapping_functor_args.ml.err +++ b/test/passing/tests/wrapping_functor_args.ml.err @@ -1,4 +0,0 @@ -Warning: tests/wrapping_functor_args.ml:22 exceeds the margin -Warning: tests/wrapping_functor_args.ml:23 exceeds the margin -Warning: tests/wrapping_functor_args.ml:24 exceeds the margin -Warning: tests/wrapping_functor_args.ml:25 exceeds the margin From 544d4160e5ceeb25ae37b9a1da7d6a77629ba57d Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 23 May 2023 12:19:57 +0200 Subject: [PATCH 05/26] Docked/wrapped module args --- lib/Fmt_ast.ml | 52 ++++++++++--------- lib/Params.ml | 6 +-- test/passing/tests/doc_comments-after.ml.ref | 18 +++---- .../doc_comments-before-except-val.ml.ref | 18 +++---- test/passing/tests/doc_comments-before.ml.ref | 18 +++---- test/passing/tests/doc_comments.ml.ref | 18 +++---- test/passing/tests/functor.ml | 33 ++++-------- test/passing/tests/functor.ml.err | 11 ---- test/passing/tests/hash_types.ml | 4 +- test/passing/tests/injectivity.ml | 12 ++--- test/passing/tests/let_module-sparse.ml.ref | 2 +- test/passing/tests/let_module.ml.ref | 2 +- test/passing/tests/wrapping_functor_args.ml | 14 ++--- 13 files changed, 92 insertions(+), 116 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 04a9e7da5b..760daecb62 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3426,11 +3426,11 @@ and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = pro $ str "sig" $ (if empty then str " " else break 1000 0 ) - $ Cmts.fmt_within c pmty_loc - $ fmt_signature c ctx s - $ (if empty then noop else break 1000 ~-2 ) - $ str "end" - $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false + $ Cmts.fmt_within c pmty_loc + $ fmt_signature c ctx s + $ (if empty then noop else break 1000 ~-2 ) + $ str "end" + $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false ) | Pmty_functor (args, mt) -> let pro = @@ -3443,7 +3443,7 @@ and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = ) $ fmt "@ " in - hvbox_if box 2 (fmt_module_type c ~pro (sub_mty ~ctx mt) $ epi ~attr:false) + fmt_module_type c ~box ~pro (sub_mty ~ctx mt) $ epi ~attr:false | Pmty_with _ -> let wcs, mt = Sugar.mod_with (sub_mty ~ctx mty) in let fmt_cstr ~first ~last:_ wc = @@ -3613,26 +3613,32 @@ and fmt_class_exprs ?ext c ctx cls = and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") name xargs xbody xmty attributes ~rec_flag = let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in - let fmt_name_and_mt ~box ~pro ~loc name mt = - let pro = - pro $ Cmts.fmt_before c loc $ str "(" $ fmt_str_loc_opt c name - $ str " : " - and epi = str ")" $ Cmts.fmt_after c loc in - fmt_module_type ~box ~pro ~epi c (sub_mty ~ctx mt) - in let args_p = Params.Mod.get_args c.conf xargs in - (* Carry the [epi] to be placed in the next argument's box. *) - let fmt_arg ~box ~pro {loc; txt} = + let fmt_name_and_mt ~pro ~docked ~loc name mt = + let pro = pro $ str "(" in + let pro_inner, pro_outer = if docked then pro, noop else noop, pro in + let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " and epi = str ")" in + pro_outer $ + hvbox_if (not docked && args_p.align) 0 ( + Cmts.fmt_before c loc $ + fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt)) + $ Cmts.fmt_after c loc + in + let fmt_arg ~pro ~docked {loc; txt} = let pro = pro $ args_p.arg_psp in match txt with | Unit -> pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) | Named (name, mt) -> - let outer_box, box = if args_p.align then hvbox 1, false else Fn.id, box in - outer_box (fmt_name_and_mt ~box ~pro ~loc name mt) + fmt_name_and_mt ~pro ~docked ~loc name mt in - let rec fmt_args ~box ~pro = function + let rec fmt_args_docked ~pro = function | [] -> pro - | hd :: tl -> fmt_arg ~box ~pro hd $ fmt_args ~box ~pro:noop tl + | hd :: tl -> fmt_args_docked ~pro:(fmt_arg ~pro ~docked:true hd) tl + in + let rec fmt_args_wrapped = function + | [] -> noop + | hd :: tl -> + fmt_arg ~pro:noop ~docked:false hd $ fmt_args_wrapped tl in let intro = str keyword @@ -3655,14 +3661,10 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword let fmt_mty = let args = - (* All signatures, put the [epi] into the box of the next arg and - don't break. *) if args_p.dock then - hovbox 4 ( - fmt_args ~box:false ~pro:intro xargs - ) + fmt_args_docked ~pro:intro xargs else - fmt_args ~box:true ~pro:intro xargs + (intro $ fmt_args_wrapped xargs) in hvbox args_p.indent ( match xmty with diff --git a/lib/Params.ml b/lib/Params.ml index c05afb9d79..4043bb70c1 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -93,15 +93,15 @@ module Mod = struct | _ -> false let get_args (c : Conf.t) args = - let indent, psp_indent = if ocp c then (2, 2) else (0, 4) in let dock = (* ocp-indent-compat: Dock only one argument to avoid alignment of subsequent arguments. *) if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false else List.for_all ~f:arg_is_sig args in - let arg_psp = if dock then str " " else break 1 psp_indent in - let align = ocp c in + let arg_psp = if dock then str " " else break 1 0 in + let indent = if dock then 0 else 4 in + let align = ocp c && not dock in {dock; arg_psp; indent; align} end diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index bf898bc834..fab197cc31 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S module Gen () : S (** Generative functor *) diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 90fa3537a7..99fabe29d9 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index 5855851529..ed72dafd1a 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 90fa3537a7..99fabe29d9 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -119,19 +119,19 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig - val blah : string + val blah : string - (* this could be a really long signature *) - end) : S + (* this could be a really long signature *) + end) : S (** Generative functor *) module Gen () : S diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml index 2d4650c6e5..0d1b8bf9d6 100644 --- a/test/passing/tests/functor.ml +++ b/test/passing/tests/functor.ml @@ -68,30 +68,15 @@ module type KV_MAKER = functor (G : Irmin_git.G) (C : Irmin.Contents.S) -> S and module Git = G module Make - (TT : TableFormat.TABLES) (IT : InspectionTableFormat.TABLES - with type 'a lr1state = int) - (ET : EngineTypes - .TABLE - with type terminal = - int - and type nonterminal = - int - and type semantic_value = - Obj.t) - (E : sig - type 'a - env = - ( ET - .state - , ET - .semantic_value - , ET - .token - ) - EngineTypes - .env - end) = -struct + (TT : TableFormat.TABLES) + (IT : InspectionTableFormat.TABLES with type 'a lr1state = int) + (ET : EngineTypes.TABLE + with type terminal = int + and type nonterminal = int + and type semantic_value = Obj.t) + (E : sig + type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env + end) = struct type t = t end diff --git a/test/passing/tests/functor.ml.err b/test/passing/tests/functor.ml.err index 8c280bc319..e69de29bb2 100644 --- a/test/passing/tests/functor.ml.err +++ b/test/passing/tests/functor.ml.err @@ -1,11 +0,0 @@ -Warning: tests/functor.ml:72 exceeds the margin -Warning: tests/functor.ml:74 exceeds the margin -Warning: tests/functor.ml:76 exceeds the margin -Warning: tests/functor.ml:78 exceeds the margin -Warning: tests/functor.ml:80 exceeds the margin -Warning: tests/functor.ml:81 exceeds the margin -Warning: tests/functor.ml:82 exceeds the margin -Warning: tests/functor.ml:84 exceeds the margin -Warning: tests/functor.ml:86 exceeds the margin -Warning: tests/functor.ml:88 exceeds the margin -Warning: tests/functor.ml:90 exceeds the margin diff --git a/test/passing/tests/hash_types.ml b/test/passing/tests/hash_types.ml index d6124f8653..2e040177ee 100644 --- a/test/passing/tests/hash_types.ml +++ b/test/passing/tests/hash_types.ml @@ -1,6 +1,6 @@ module F (X : sig - type t - end) = struct + type t +end) = struct class type ['a] c = object method m : 'a -> X.t end diff --git a/test/passing/tests/injectivity.ml b/test/passing/tests/injectivity.ml index 2a6173d8b1..76291b1fa3 100644 --- a/test/passing/tests/injectivity.ml +++ b/test/passing/tests/injectivity.ml @@ -59,20 +59,20 @@ end type !'a u = int constraint 'a = 'b t module F (X : sig - type 'a t - end) = struct + type 'a t +end) = struct type !'a u = 'b constraint 'a = < b: 'b > constraint 'b = _ X.t end module F (X : sig - type 'a t - end) = struct + type 'a t +end) = struct type !'a u = 'b X.t constraint 'a = < b: 'b X.t > end module F (X : sig - type 'a t - end) = struct + type 'a t +end) = struct type !'a u = 'b constraint 'a = < b: (_ X.t as 'b) > end diff --git a/test/passing/tests/let_module-sparse.ml.ref b/test/passing/tests/let_module-sparse.ml.ref index 976d5928e6..66a42f904a 100644 --- a/test/passing/tests/let_module-sparse.ml.ref +++ b/test/passing/tests/let_module-sparse.ml.ref @@ -57,5 +57,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/let_module.ml.ref b/test/passing/tests/let_module.ml.ref index 9b100468d7..e484db2ded 100644 --- a/test/passing/tests/let_module.ml.ref +++ b/test/passing/tests/let_module.ml.ref @@ -49,5 +49,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index dcf8c9ae04..16ea5dc32b 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -1,8 +1,8 @@ module F3 - (G : functor - (_ : T____________________________________________) - (_ : T____________________________________________) -> - T) - (A : sig - val x : int - end) = struct end + (G : functor + (_ : T____________________________________________) + (_ : T____________________________________________) -> + T) + (A : sig + val x : int + end) = struct end From daedfda97a1236251aa3b86bba09cc9318679b71 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 23 May 2023 12:21:12 +0200 Subject: [PATCH 06/26] fmt --- lib/Ast.ml | 2 +- lib/Fmt_ast.ml | 114 ++++++++++++++++++++++++------------------------- 2 files changed, 56 insertions(+), 60 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index ed981e54ca..97e02add06 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -1788,7 +1788,7 @@ end = struct (** [parenze_mty {ctx; ast}] holds when module type [ast] should be parenthesized in context [ctx]. *) - let parenze_mty {ctx=_; ast= mty} = + let parenze_mty {ctx= _; ast= mty} = match mty.pmty_desc with | Pmty_ident _ | Pmty_extension _ -> false | _ -> Mty.has_trailing_attributes mty diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 760daecb62..6797fde2a9 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3408,39 +3408,43 @@ and fmt_functor_param c ctx {loc; txt= arg} = (wrap "(" ")" (hovbox 0 ( hovbox 0 (fmt_str_loc_opt c name $ fmt "@ : ") - $ (fmt_module_type c xmt) ) ) ) + $ fmt_module_type c xmt ) ) ) -and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = +and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t + = let ctx = Mty mty in let {pmty_desc; pmty_loc; pmty_attributes} = mty in update_config_maybe_disabled c pmty_loc pmty_attributes @@ fun c -> let parens = parenze_mty xmty in let pro = fmt_opt pro $ fmt_if parens "(" $ Cmts.fmt_before c pmty_loc - and epi ~attr = Cmts.fmt_after ~pro:(str " ") c pmty_loc $ fmt_if parens ")" $ fmt_if_k attr (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) $ fmt_opt epi in + and epi ~attr = + Cmts.fmt_after ~pro:(str " ") c pmty_loc + $ fmt_if parens ")" + $ fmt_if_k attr (fmt_attributes c pmty_attributes ~pre:(Break (1, 0))) + $ fmt_opt epi + in match pmty_desc with | Pmty_ident lid -> pro $ fmt_longident_loc c lid $ epi ~attr:true | Pmty_signature s -> let empty = List.is_empty s && not (Cmts.has_within c.cmts pmty_loc) in - hvbox_if box 2 ( - pro $ - str "sig" - $ (if empty then str " " else break 1000 0 ) + hvbox_if box 2 + ( pro $ str "sig" + $ (if empty then str " " else break 1000 0) $ Cmts.fmt_within c pmty_loc $ fmt_signature c ctx s - $ (if empty then noop else break 1000 ~-2 ) + $ (if empty then noop else break 1000 ~-2) $ str "end" - $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false - ) + $ fmt_attributes_and_docstrings c pmty_attributes + $ epi ~attr:false ) | Pmty_functor (args, mt) -> let pro = - hvbox 2 ( - pro $ str "functor" + hvbox 2 + ( pro $ str "functor" $ fmt_attributes c ~pre:Blank pmty_attributes $ fmt "@ " $ list args "@ " (fmt_functor_param c ctx) - $ fmt " ->" - ) + $ fmt " ->" ) $ fmt "@ " in fmt_module_type c ~box ~pro (sub_mty ~ctx mt) $ epi ~attr:false @@ -3451,22 +3455,21 @@ and fmt_module_type c ?(box=true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = fmt_if (not first) "@," $ fmt_with_constraint c ctx ~pre wc in let fmt_cstrs ~first:_ ~last:_ (wcs_and, loc, attr) = - fmt "@ " $ hvbox 0 (Cmts.fmt c loc - ( list_fl wcs_and fmt_cstr - $ fmt_attributes c ~pre:(Break (1, -1)) attr )) + fmt "@ " + $ hvbox 0 + (Cmts.fmt c loc + ( list_fl wcs_and fmt_cstr + $ fmt_attributes c ~pre:(Break (1, -1)) attr ) ) in - hovbox_if box 2 ( - fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs - $ epi ~attr:false (* Handled by [Sugar.mod_with]. *) - ) + hovbox_if box 2 + ( fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs + $ epi ~attr:false (* Handled by [Sugar.mod_with]. *) ) | Pmty_typeof me -> let pro = pro $ fmt "module type of@ " in let me_blk = fmt_module_expr c (sub_mod ~ctx me) in hvbox_if box 2 (compose_module ~pro me_blk ~f:Fn.id $ epi ~attr:true) - | Pmty_extension ext -> - pro $ fmt_extension c ctx ext $ epi ~attr:true - | Pmty_alias lid -> - pro $ fmt_longident_loc c lid $ epi ~attr:true + | Pmty_extension ext -> pro $ fmt_extension c ctx ext $ epi ~attr:true + | Pmty_alias lid -> pro $ fmt_longident_loc c lid $ epi ~attr:true and fmt_signature c ctx itms = let update_config c i = @@ -3512,11 +3515,11 @@ and fmt_signature_item c ?ext {ast= si; _} = let force_before = not (Mty.is_simple pincl_mod) in fmt_docstring_around_item c ~force_before ~fit:true pincl_attributes in - let pro = str "include" $ fmt_extension_suffix c ext $ str " " in + let pro = str "include" $ fmt_extension_suffix c ext $ str " " in hvbox 0 ( doc_before - $ hvbox 0 ( - fmt_module_type ~pro c (sub_mty ~ctx pincl_mod) + $ hvbox 0 + ( fmt_module_type ~pro c (sub_mty ~ctx pincl_mod) $ fmt_item_attributes c ~pre:(Break (1, 0)) atrs ) $ doc_after ) | Psig_modtype mtd -> fmt_module_type_declaration ?ext c ctx mtd @@ -3610,26 +3613,28 @@ and fmt_class_exprs ?ext c ctx cls = $ hovbox 0 @@ Cmts.fmt c cl.pci_loc (doc_before $ class_exprs $ doc_after) ) -and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword - ?(eqty = "=") name xargs xbody xmty attributes ~rec_flag = +and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") + name xargs xbody xmty attributes ~rec_flag = let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in let args_p = Params.Mod.get_args c.conf xargs in let fmt_name_and_mt ~pro ~docked ~loc name mt = let pro = pro $ str "(" in - let pro_inner, pro_outer = if docked then pro, noop else noop, pro in - let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " and epi = str ")" in - pro_outer $ - hvbox_if (not docked && args_p.align) 0 ( - Cmts.fmt_before c loc $ - fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt)) + let pro_inner, pro_outer = if docked then (pro, noop) else (noop, pro) in + let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " + and epi = str ")" in + pro_outer + $ hvbox_if + ((not docked) && args_p.align) + 0 + ( Cmts.fmt_before c loc + $ fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt) ) $ Cmts.fmt_after c loc in let fmt_arg ~pro ~docked {loc; txt} = let pro = pro $ args_p.arg_psp in match txt with | Unit -> pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) - | Named (name, mt) -> - fmt_name_and_mt ~pro ~docked ~loc name mt + | Named (name, mt) -> fmt_name_and_mt ~pro ~docked ~loc name mt in let rec fmt_args_docked ~pro = function | [] -> pro @@ -3637,8 +3642,7 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword in let rec fmt_args_wrapped = function | [] -> noop - | hd :: tl -> - fmt_arg ~pro:noop ~docked:false hd $ fmt_args_wrapped tl + | hd :: tl -> fmt_arg ~pro:noop ~docked:false hd $ fmt_args_wrapped tl in let intro = str keyword @@ -3658,23 +3662,18 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword fmt_docstring_around_item c ~force_before:(not single_line) ~fit:true attributes in - let fmt_mty = let args = - if args_p.dock then - fmt_args_docked ~pro:intro xargs - else - (intro $ fmt_args_wrapped xargs) + if args_p.dock then fmt_args_docked ~pro:intro xargs + else intro $ fmt_args_wrapped xargs in - hvbox args_p.indent ( - match xmty with + hvbox args_p.indent + ( match xmty with | Some xmty -> let pro = args $ str " " $ str eqty $ str " " in fmt_module_type ~pro c xmty - | None -> args - ) + | None -> args ) in - hvbox (if compact then 0 else 2) ( doc_before @@ -3713,8 +3712,8 @@ and fmt_module_declaration ?ext c ~rec_flag ~first {ast= pmd; _} = match xmty.ast.pmty_desc with Pmty_alias _ -> None | _ -> Some ":" in Cmts.fmt c pmd_loc - (fmt_module ?ext c ctx keyword pmd_name pmd_args None - ?eqty (Some xmty) ~rec_flag:(rec_flag && first) pmd_attributes ) + (fmt_module ?ext c ctx keyword pmd_name pmd_args None ?eqty (Some xmty) + ~rec_flag:(rec_flag && first) pmd_attributes ) and fmt_module_substitution ?ext c ctx pms = let {pms_name; pms_manifest; pms_attributes; pms_loc} = pms in @@ -3916,8 +3915,7 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) = hvbox 0 ( fmt_opt blk_e.pro $ blk_e.psp $ blk_e.bdy $ blk_e.esp $ fmt_opt blk_e.epi $ fmt " :@;<1 2>" - $ hvbox 0 - (fmt_module_type c (sub_mty ~ctx mt)) ) + $ hvbox 0 (fmt_module_type c (sub_mty ~ctx mt)) ) $ closing_paren c ~offset:(-2) ; cls= close_box $ blk_e.cls ; esp= noop @@ -4279,9 +4277,8 @@ and fmt_module_binding ?ext c ~rec_flag ~first {ast= pmb; _} = | _ -> (xbody, None) in Cmts.fmt c pmb.pmb_loc - (fmt_module ?ext c ctx keyword - ~rec_flag:(rec_flag && first) ~eqty:":" pmb.pmb_name pmb.pmb_args - (Some xbody) xmty pmb.pmb_attributes ) + (fmt_module ?ext c ctx keyword ~rec_flag:(rec_flag && first) ~eqty:":" + pmb.pmb_name pmb.pmb_args (Some xbody) xmty pmb.pmb_attributes ) let fmt_toplevel_directive c ~semisemi dir = let fmt_dir_arg = function @@ -4397,8 +4394,7 @@ let fmt_file (type a) ~ctx ~fmt_code ~debug (fragment : a Extended_ast.t) | Signature, l -> Chunk.split_and_fmt Signature c ctx l | Use_file, l -> Chunk.split_and_fmt Use_file c ctx l | Core_type, ty -> fmt_core_type c (sub_typ ~ctx:(Pld (PTyp ty)) ty) - | Module_type, mty -> - (fmt_module_type c (sub_mty ~ctx:(Mty mty) mty)) + | Module_type, mty -> fmt_module_type c (sub_mty ~ctx:(Mty mty) mty) | Expression, e -> fmt_expression c (sub_exp ~ctx:(Str (Ast_helper.Str.eval e)) e) | Repl_file, l -> fmt_repl_file c ctx l From 706259c0c6a533547a361c86e9478df825fcfba9 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 23 May 2023 18:13:01 +0200 Subject: [PATCH 07/26] Fix placement of comments around module arguments --- lib/Fmt_ast.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 6797fde2a9..8d4f3efa1b 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3428,11 +3428,12 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t | Pmty_ident lid -> pro $ fmt_longident_loc c lid $ epi ~attr:true | Pmty_signature s -> let empty = List.is_empty s && not (Cmts.has_within c.cmts pmty_loc) in + (* Side effect before [epi ~attr] is important. *) + let cmts_within = Cmts.fmt_within ~pro:noop c pmty_loc in hvbox_if box 2 ( pro $ str "sig" $ (if empty then str " " else break 1000 0) - $ Cmts.fmt_within c pmty_loc - $ fmt_signature c ctx s + $ cmts_within $ fmt_signature c ctx s $ (if empty then noop else break 1000 ~-2) $ str "end" $ fmt_attributes_and_docstrings c pmty_attributes @@ -3618,7 +3619,7 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in let args_p = Params.Mod.get_args c.conf xargs in let fmt_name_and_mt ~pro ~docked ~loc name mt = - let pro = pro $ str "(" in + let pro = pro $ Cmts.fmt_before c loc $ str "(" in let pro_inner, pro_outer = if docked then (pro, noop) else (noop, pro) in let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " and epi = str ")" in @@ -3626,8 +3627,7 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") $ hvbox_if ((not docked) && args_p.align) 0 - ( Cmts.fmt_before c loc - $ fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt) ) + (fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt)) $ Cmts.fmt_after c loc in let fmt_arg ~pro ~docked {loc; txt} = From 1aa8e28c9c299b7992ca00e7e34d0e64df8c4b6c Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 23 May 2023 18:38:36 +0200 Subject: [PATCH 08/26] Parens around module type expr of rec module decl --- lib/Ast.ml | 10 +- test/passing/tests/js_source.ml.err | 13 +- test/passing/tests/js_source.ml.ocp | 121 +++++++------- test/passing/tests/js_source.ml.ref | 199 +++++++++++------------- test/passing/tests/module_type.ml | 82 +++++----- test/passing/tests/shortcut_ext_attr.ml | 6 +- test/passing/tests/source.ml.ref | 138 +++++++--------- 7 files changed, 256 insertions(+), 313 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index 97e02add06..46446e6772 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -1788,9 +1788,13 @@ end = struct (** [parenze_mty {ctx; ast}] holds when module type [ast] should be parenthesized in context [ctx]. *) - let parenze_mty {ctx= _; ast= mty} = - match mty.pmty_desc with - | Pmty_ident _ | Pmty_extension _ -> false + let parenze_mty {ctx; ast= mty} = + match (ctx, mty.pmty_desc) with + | _, (Pmty_ident _ | Pmty_extension _ | Pmty_signature _) -> false + (* [Pmty_with] must be parenthesed when on the RHS of a recursive module + decl. This is an over-approximation. *) + | Md _, Pmty_with _ -> true + | (Str _ | Sig _), _ -> false | _ -> Mty.has_trailing_attributes mty (** [parenze_mod {ctx; ast}] holds when module expr [ast] should be diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 9ba7830b7d..20046f6e4a 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,7 +1,6 @@ -Warning: tests/js_source.ml:155 exceeds the margin -Warning: tests/js_source.ml:3556 exceeds the margin -Warning: tests/js_source.ml:9522 exceeds the margin -Warning: tests/js_source.ml:9625 exceeds the margin -Warning: tests/js_source.ml:9644 exceeds the margin -Warning: tests/js_source.ml:9684 exceeds the margin -Warning: tests/js_source.ml:9768 exceeds the margin +Warning: tests/js_source.ml:3553 exceeds the margin +Warning: tests/js_source.ml:9507 exceeds the margin +Warning: tests/js_source.ml:9610 exceeds the margin +Warning: tests/js_source.ml:9629 exceeds the margin +Warning: tests/js_source.ml:9669 exceeds the margin +Warning: tests/js_source.ml:9753 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 11d0dd179e..c5d9c3df68 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -14,10 +14,11 @@ end [@foo] [@@foo] module type S = sig - include ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) [@@foo] + include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end [@foo] +end + [@foo] [@@foo] [@@@foo] @@ -153,15 +154,16 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end - [@foo] +module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> +sig end +[@foo] module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S -module type S = functor (_ : functor [@foo] (M : S) -> S) -> S +module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S +module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S module type S = sig module rec A : (S with type t = t) @@ -563,7 +565,8 @@ module Msg : sig val read : string -> t end - module Define (D : Desc) : sig + module Define + (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -2364,8 +2367,7 @@ let inlineseq_from_astseq seq = module Add (T : sig type two - end) = -struct + end) = struct type _ t = | One : [ `One ] t | Two : T.two t @@ -2450,8 +2452,7 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig type 'a t - end) = -struct + end) = struct type _ ab = | A : int S.t ab | B : float S.t ab @@ -2465,8 +2466,7 @@ end module F (S : sig type 'a t - end) = -struct + end) = struct type a = int * int type b = int -> int @@ -2569,8 +2569,7 @@ let f : (int s, int t) eq -> unit = function module M (S : sig type 'a t = T of 'a type 'a s = T of 'a - end) = -struct + end) = struct let f : ('a S.s, 'a S.t) eq -> unit = function | Refl -> () ;; @@ -2611,8 +2610,7 @@ module M end) (B : sig module type T - end) = -struct + end) = struct let f : ((module A.T), (module B.T)) t -> string = function | B s -> s ;; @@ -2810,8 +2808,7 @@ let f (type a) (Neq n : (a, a t) eq) = n module F (T : sig type _ t - end) = -struct + end) = struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -4693,8 +4690,7 @@ module F (M : sig type 'a u = string val f : unit -> _ u t - end) = -struct + end) = struct let t = M.f () end @@ -4748,8 +4744,7 @@ module F module type T end) (A : S.T) - (B : S.T) = -struct + (B : S.T) = struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4796,8 +4791,8 @@ module type PR6513 = sig type uri end - module Make : functor (Html5 : T with type 'a wrap = 'a) -> - S with type u = < foo : Html5.uri > + module Make : functor (Html5 : T with type 'a wrap = 'a) -> S + with type u = < foo : Html5.uri > end (* Requires -package tyxml @@ -4959,8 +4954,7 @@ end module Foo (Bar : S with type a = private [> `A ]) - (Baz : S with type b = private < b : Bar.b ; .. >) = -struct end + (Baz : S with type b = private < b : Bar.b ; .. >) = struct end module A = struct module type A_S = sig end @@ -4995,10 +4989,10 @@ module Foo (Bar : sig type a = private [> `A ] end) - (Baz : module type of struct + (Baz : module type of + struct include Bar - end) = -struct end + end) = struct end module Bazoinks = struct type a = [ `A ] @@ -5013,8 +5007,7 @@ let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig type 'a f - end) = -struct + end) = struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5421,7 +5414,8 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> sig +module G : functor (X : sig end) -> +sig module N' : sig val x : int end @@ -5536,8 +5530,7 @@ include C module F (X : sig module C = Char - end) = -struct + end) = struct module C = X.C end @@ -5601,8 +5594,7 @@ module F end) (M : sig type t = Y.t - end) = -struct end + end) = struct end module G = F (M.Y) @@ -6683,8 +6675,7 @@ class ['a] s3object r : ['a] s3 = module M (T : sig type t - end) = -struct + end) = struct type t = private { t : T.t } end @@ -7064,8 +7055,8 @@ module PR_4261 = struct type t = D.t end - module rec U : (T with module D = U') = U - and U' : (S with type t = U'.t) = U + module rec U : T with module D = U' = U + and U' : S with type t = U'.t = U end (* Bad - PR 4512 *) @@ -7073,7 +7064,7 @@ module type S' = sig type t = int end -module rec M : (S' with type t = M.t) = struct +module rec M : S' with type t = M.t = struct type t = M.t end @@ -7138,8 +7129,8 @@ type 'a tree = | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : - SET with type elt = int = struct + (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : SET + with type elt = int = struct type elt = int module rec Elt : sig @@ -7165,7 +7156,7 @@ module Bootstrap2 ;; end - and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = MakeDiet (Elt) + and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet (Elt) type t = Diet.t @@ -7248,7 +7239,7 @@ module PR_4557 = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end end @@ -7278,7 +7269,7 @@ module F (X : Set.OrderedType) = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end (* Tests for recursive modules *) @@ -7311,7 +7302,7 @@ end = struct ;; end -and ASet : (Set.S with type elt = A.t) = Set.Make (A) +and ASet : Set.S with type elt = A.t = Set.Make (A) let _ = let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in @@ -7570,8 +7561,7 @@ module type HEAP = sig val deleteMin : heap -> heap end -module Bootstrap - (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) +module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element @@ -7613,7 +7603,7 @@ module Bootstrap ;; end - and PrimH : (HEAP with type Elem.t = BE.t) = MakeH (BE) + and PrimH : HEAP with type Elem.t = BE.t = MakeH (BE) type heap = BE.t @@ -7805,8 +7795,7 @@ let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig val f : int -> int - end) = -struct + end) = struct let x = 0 let at a = A.f a end @@ -7853,8 +7842,7 @@ let _ = (* PR#4316 *) module G (S : sig val x : int Lazy.t - end) = -struct + end) = struct include S end @@ -7947,8 +7935,7 @@ end module F (X : sig val x : (module S) - end) = -struct + end) = struct module A = (val X.x) end @@ -8212,7 +8199,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : AST with module Value := Value + module Ast : (AST with module Value := Value) type state = Value.state type value = Value.value @@ -8232,7 +8219,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : PARSER with type chunk = Ast.chunk + module Parser : (PARSER with type chunk = Ast.chunk) val dostring : state -> string -> value list val mk : unit -> state @@ -8257,8 +8244,8 @@ module type COMBINED_COMMON = sig type t end - module TV1 : TYPEVIEW with type combined := T.t - module TV2 : TYPEVIEW with type combined := T.t + module TV1 : (TYPEVIEW with type combined := T.t) + module TV2 : (TYPEVIEW with type combined := T.t) end module type COMBINED_TYPE = sig @@ -8273,8 +8260,8 @@ module type BARECODE = sig end module USERCODE (X : TYPEVIEW) = struct - module type F = functor (C : CORE with type V.usert = X.combined) -> - BARECODE with type state := C.V.state + module type F = functor (C : CORE with type V.usert = X.combined) -> BARECODE + with type state := C.V.state end module Weapon = struct @@ -8284,7 +8271,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : USERTYPE with type t = t + module T : (USERTYPE with type t = t) module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end @@ -8299,8 +8286,7 @@ module type S = sig module M : sig type t end -end -with module M = M +end with module M = M module type Printable = sig type t @@ -8374,8 +8360,7 @@ module type S' = S with module T := M module type S = sig type 'a t -end -with type 'a t := unit +end with type 'a t := unit (* Fails *) let property (type t) () = diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 7c3cb1ac43..d822c698fc 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -14,10 +14,11 @@ end [@foo] [@@foo] module type S = sig - include ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) [@@foo] + include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end [@foo] +end + [@foo] [@@foo] [@@@foo] @@ -153,15 +154,16 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> sig end -[@foo] +module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> + sig end + [@foo] module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S -module type S = functor (_ : functor [@foo] (M : S) -> S) -> S +module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S +module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S module type S = sig module rec A : (S with type t = t) @@ -563,7 +565,8 @@ module Msg : sig val read : string -> t end - module Define (D : Desc) : sig + module Define + (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -2363,9 +2366,8 @@ let inlineseq_from_astseq seq = ;; module Add (T : sig - type two - end) = -struct + type two +end) = struct type _ t = | One : [ `One ] t | Two : T.two t @@ -2449,9 +2451,8 @@ let example6 : type a. a wrapPoly -> a -> int = let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig - type 'a t - end) = -struct + type 'a t +end) = struct type _ ab = | A : int S.t ab | B : float S.t ab @@ -2464,9 +2465,8 @@ struct end module F (S : sig - type 'a t - end) = -struct + type 'a t +end) = struct type a = int * int type b = int -> int @@ -2567,10 +2567,9 @@ let f : (int s, int t) eq -> unit = function ;; module M (S : sig - type 'a t = T of 'a - type 'a s = T of 'a - end) = -struct + type 'a t = T of 'a + type 'a s = T of 'a +end) = struct let f : ('a S.s, 'a S.t) eq -> unit = function | Refl -> () ;; @@ -2606,13 +2605,12 @@ type (_, _) t = | B : string -> ('a, 'b) t module M - (A : sig - module type T - end) - (B : sig - module type T - end) = -struct + (A : sig + module type T + end) + (B : sig + module type T + end) = struct let f : ((module A.T), (module B.T)) t -> string = function | B s -> s ;; @@ -2809,9 +2807,8 @@ let f (type a) (Neq n : (a, a t) eq) = n (* warn! *) module F (T : sig - type _ t - end) = -struct + type _ t +end) = struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -3022,8 +3019,8 @@ let magic : 'a 'b. 'a -> 'b = let module M = (functor (T : sig - type 'a t - end) + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) @@ -4689,12 +4686,11 @@ let x = (3 : X2.F(DUMMY)(DUMMY).t) let x = (3 : X2.F(DUMMY)(DUMMY).t') module F (M : sig - type 'a t - type 'a u = string + type 'a t + type 'a u = string - val f : unit -> _ u t - end) = -struct + val f : unit -> _ u t +end) = struct let t = M.f () end @@ -4744,12 +4740,11 @@ let f (module M : S with type t = int) = { M.a = 0 } let flag = ref false module F - (S : sig - module type T - end) - (A : S.T) - (B : S.T) = -struct + (S : sig + module type T + end) + (A : S.T) + (B : S.T) = struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4796,8 +4791,8 @@ module type PR6513 = sig type uri end - module Make : functor (Html5 : T with type 'a wrap = 'a) -> - S with type u = < foo : Html5.uri > + module Make : functor (Html5 : T with type 'a wrap = 'a) -> S + with type u = < foo : Html5.uri > end (* Requires -package tyxml @@ -4958,9 +4953,8 @@ module type S = sig end module Foo - (Bar : S with type a = private [> `A ]) - (Baz : S with type b = private < b : Bar.b ; .. >) = -struct end + (Bar : S with type a = private [> `A ]) + (Baz : S with type b = private < b : Bar.b ; .. >) = struct end module A = struct module type A_S = sig end @@ -4992,13 +4986,13 @@ let _ = f (module A_alias : S with type t = (module A.A_S)) (* doesn't type *) let _ = f (module A_alias) (* doesn't type either *) module Foo - (Bar : sig - type a = private [> `A ] - end) - (Baz : module type of struct + (Bar : sig + type a = private [> `A ] + end) + (Baz : module type of + struct include Bar - end) = -struct end + end) = struct end module Bazoinks = struct type a = [ `A ] @@ -5012,9 +5006,8 @@ type (_, _) eq = Eq : ('a, 'a) eq let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig - type 'a f - end) = -struct + type 'a f +end) = struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5421,7 +5414,8 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> sig +module G : functor (X : sig end) -> + sig module N' : sig val x : int end @@ -5535,9 +5529,8 @@ C.one.Complex.re include C module F (X : sig - module C = Char - end) = -struct + module C = Char +end) = struct module C = X.C end @@ -5596,13 +5589,12 @@ module M = struct end module F - (Y : sig - type t - end) - (M : sig - type t = Y.t - end) = -struct end + (Y : sig + type t + end) + (M : sig + type t = Y.t + end) = struct end module G = F (M.Y) @@ -6682,9 +6674,8 @@ class ['a] s3object r : ['a] s3 = end module M (T : sig - type t - end) = -struct + type t +end) = struct type t = private { t : T.t } end @@ -7064,8 +7055,8 @@ module PR_4261 = struct type t = D.t end - module rec U : (T with module D = U') = U - and U' : (S with type t = U'.t) = U + module rec U : T with module D = U' = U + and U' : S with type t = U'.t = U end (* Bad - PR 4512 *) @@ -7073,7 +7064,7 @@ module type S' = sig type t = int end -module rec M : (S' with type t = M.t) = struct +module rec M : S' with type t = M.t = struct type t = M.t end @@ -7138,8 +7129,8 @@ type 'a tree = | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : - SET with type elt = int = struct + (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : SET + with type elt = int = struct type elt = int module rec Elt : sig @@ -7165,7 +7156,7 @@ module Bootstrap2 ;; end - and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = MakeDiet (Elt) + and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet (Elt) type t = Diet.t @@ -7248,7 +7239,7 @@ module PR_4557 = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end end @@ -7278,7 +7269,7 @@ module F (X : Set.OrderedType) = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end (* Tests for recursive modules *) @@ -7311,7 +7302,7 @@ end = struct ;; end -and ASet : (Set.S with type elt = A.t) = Set.Make (A) +and ASet : Set.S with type elt = A.t = Set.Make (A) let _ = let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in @@ -7570,9 +7561,8 @@ module type HEAP = sig val deleteMin : heap -> heap end -module Bootstrap - (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct +module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) + (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig @@ -7613,7 +7603,7 @@ module Bootstrap ;; end - and PrimH : (HEAP with type Elem.t = BE.t) = MakeH (BE) + and PrimH : HEAP with type Elem.t = BE.t = MakeH (BE) type heap = BE.t @@ -7804,9 +7794,8 @@ and Coerce3 : sig end = struct end let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig - val f : int -> int - end) = -struct + val f : int -> int +end) = struct let x = 0 let at a = A.f a end @@ -7852,9 +7841,8 @@ let _ = (* PR#4316 *) module G (S : sig - val x : int Lazy.t - end) = -struct + val x : int Lazy.t +end) = struct include S end @@ -7946,9 +7934,8 @@ module type S = sig end module F (X : sig - val x : (module S) - end) = -struct + val x : (module S) +end) = struct module A = (val X.x) end @@ -8212,7 +8199,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : AST with module Value := Value + module Ast : (AST with module Value := Value) type state = Value.state type value = Value.value @@ -8232,7 +8219,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : PARSER with type chunk = Ast.chunk + module Parser : (PARSER with type chunk = Ast.chunk) val dostring : state -> string -> value list val mk : unit -> state @@ -8257,8 +8244,8 @@ module type COMBINED_COMMON = sig type t end - module TV1 : TYPEVIEW with type combined := T.t - module TV2 : TYPEVIEW with type combined := T.t + module TV1 : (TYPEVIEW with type combined := T.t) + module TV2 : (TYPEVIEW with type combined := T.t) end module type COMBINED_TYPE = sig @@ -8273,8 +8260,8 @@ module type BARECODE = sig end module USERCODE (X : TYPEVIEW) = struct - module type F = functor (C : CORE with type V.usert = X.combined) -> - BARECODE with type state := C.V.state + module type F = functor (C : CORE with type V.usert = X.combined) -> BARECODE + with type state := C.V.state end module Weapon = struct @@ -8284,7 +8271,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : USERTYPE with type t = t + module T : (USERTYPE with type t = t) module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end @@ -8296,11 +8283,10 @@ module M = struct end module type S = sig - module M : sig - type t - end + module M : sig + type t end - with module M = M +end with module M = M module type Printable = sig type t @@ -8373,9 +8359,8 @@ end module type S' = S with module T := M module type S = sig - type 'a t - end - with type 'a t := unit + type 'a t +end with type 'a t := unit (* Fails *) let property (type t) () = diff --git a/test/passing/tests/module_type.ml b/test/passing/tests/module_type.ml index a13548bcb8..c3daede2e2 100644 --- a/test/passing/tests/module_type.ml +++ b/test/passing/tests/module_type.ml @@ -24,43 +24,31 @@ module type BAR = sig and B : FOO end -module type M = - module type of M - with module A := A - (*test*) - and module A = A - (*test*) - and module A = A - with module A = A - (*test*) - with module A = A - -module U : - S - with type ttttttttt = int - and type uuuuuuuu = int - and type vvvvvvvvvvv = int = struct end - -module U : - S - with type ttttttttt = int - and type uuuuuuu = int - with type vvvvvvvvv = int = struct end - -module U : - S - with type Command.t = - [ `Halt - | `Unknown - | `Error of string - | `Config of (string * string) list - | `Format of string ] - and type Command.t = - [ `Halt - | `Unknown - | `Error of string - | `Config of (string * string) list - | `Format of string ] = struct end +module type M = module type of M + with module A := A (*test*) and module A = A (*test*) and module A = A + with module A = A (*test*) with module A = A + +module U : S + with type ttttttttt = int + and type uuuuuuuu = int + and type vvvvvvvvvvv = int = struct end + +module U : S with type ttttttttt = int and type uuuuuuu = int + with type vvvvvvvvv = int = struct end + +module U : S + with type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] + and type Command.t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] = struct end module U = (val S : S with type t = int and type u = int) @@ -75,24 +63,24 @@ end module type S' = functor (A : A) (B : sig - type t - end) + type t + end) (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc : sig - type t - end) - -> S with type t = B.t + type t + end) -> S with type t = B.t module M : sig include (* foo *) module type of K include module type of - Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) - (Fooooooooooooo) + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) - include (* fooooooooo *) module type of - Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) - (Fooooooooooooo) + include (* fooooooooo *) + module type of + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) end = struct end let foo (type foooo fooo_ooooo) diff --git a/test/passing/tests/shortcut_ext_attr.ml b/test/passing/tests/shortcut_ext_attr.ml index e020a02644..44bdcd89f0 100644 --- a/test/passing/tests/shortcut_ext_attr.ml +++ b/test/passing/tests/shortcut_ext_attr.ml @@ -78,11 +78,11 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = (functor [@foo1] (M : S) -> +module type S = functor [@foo1] (M : S) -> functor (_ : (module type of M) [@foo2]) -> - (sig end - [@foo3])) + sig end + [@foo3] (* Structure items *) let%foo[@foo] x = 4 diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 29234fddd3..4d704583d0 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -14,12 +14,11 @@ end [@foo] [@@foo] module type S = sig - include - ((module type of M [@foo]) [@foo] with type t := M.t [@foo]) - [@@foo] + include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end [@foo] +end + [@foo] [@@foo] [@@@foo] @@ -182,11 +181,11 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo] - (M : S) - -> functor - (_ : (module type of M) [@foo]) - -> sig end [@foo] +module type S = functor [@foo] (M : S) -> + functor + (_ : (module type of M) [@foo]) -> + sig end + [@foo] module type S = functor (_ : S) (_ : S) -> S @@ -196,9 +195,9 @@ module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S +module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S -module type S = functor (_ : functor [@foo] (M : S) -> S) -> S +module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S module type S = sig module rec A : (S with type t = t) @@ -658,7 +657,8 @@ module Msg : sig val read : string -> t end - module Define (D : Desc) : sig + module Define + (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -2340,8 +2340,7 @@ let inlineseq_from_astseq seq = module Add (T : sig type two -end) = -struct +end) = struct type _ t = One : [`One] t | Two : T.two t let add (type a) : a t * a t -> string = function @@ -2404,8 +2403,7 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig type 'a t -end) = -struct +end) = struct type _ ab = A : int S.t ab | B : float S.t ab let f : int S.t ab -> float S.t ab -> string = @@ -2415,8 +2413,7 @@ end module F (S : sig type 'a t -end) = -struct +end) = struct type a = int * int type b = int -> int @@ -2503,8 +2500,7 @@ module M (S : sig type 'a t = T of 'a type 'a s = T of 'a -end) = -struct +end) = struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end @@ -2534,8 +2530,7 @@ module M (A : sig module type T end) (B : sig module type T -end) = -struct +end) = struct let f : ((module A.T), (module B.T)) t -> string = function B s -> s end @@ -2710,8 +2705,7 @@ let f (type a) (Neq n : (a, a t) eq) = n module F (T : sig type _ t -end) = -struct +end) = struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -2890,8 +2884,8 @@ let magic : 'a 'b. 'a -> 'b = let module M = (functor (T : sig - type 'a t - end) + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) @@ -4448,8 +4442,7 @@ module F (M : sig type 'a u = string val f : unit -> _ u t -end) = -struct +end) = struct let t = M.f () end @@ -4503,11 +4496,10 @@ let flag = ref false module F (S : sig - module type T - end) + module type T + end) (A : S.T) - (B : S.T) = -struct + (B : S.T) = struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4555,8 +4547,8 @@ module type PR6513 = sig type uri end - module Make : functor (Html5 : T with type 'a wrap = 'a) -> - S with type u = < foo: Html5.uri > + module Make : functor (Html5 : T with type 'a wrap = 'a) -> S + with type u = < foo: Html5.uri > end (* Requires -package tyxml module type PR6513_orig = sig module type S = sig @@ -4711,8 +4703,7 @@ end module Foo (Bar : S with type a = private [> `A]) - (Baz : S with type b = private < b: Bar.b ; .. >) = -struct end + (Baz : S with type b = private < b: Bar.b ; .. >) = struct end module A = struct module type A_S = sig end @@ -4752,10 +4743,10 @@ let _ = f (module A_alias) (* doesn't type either *) module Foo (Bar : sig type a = private [> `A] -end) (Baz : module type of struct - include Bar -end) = -struct end +end) (Baz : module type of + struct + include Bar + end) = struct end module Bazoinks = struct type a = [`A] @@ -4770,8 +4761,7 @@ let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig type 'a f -end) = -struct +end) = struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5177,7 +5167,8 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> sig +module G : functor (X : sig end) -> + sig module N' : sig val x : int end @@ -5292,8 +5283,7 @@ include C module F (X : sig module C = Char -end) = -struct +end) = struct module C = X.C end @@ -5357,8 +5347,7 @@ module F (Y : sig type t end) (M : sig type t = Y.t -end) = -struct end +end) = struct end module G = F (M.Y) @@ -6447,8 +6436,7 @@ class ['a] s3object r : ['a] s3 = module M (T : sig type t -end) = -struct +end) = struct type t = private {t: T.t} end @@ -6838,9 +6826,9 @@ module PR_4261 = struct type t = D.t end - module rec U : (T with module D = U') = U + module rec U : T with module D = U' = U - and U' : (S with type t = U'.t) = U + and U' : S with type t = U'.t = U end (* Bad - PR 4512 *) @@ -6848,7 +6836,7 @@ module type S' = sig type t = int end -module rec M : (S' with type t = M.t) = struct +module rec M : S' with type t = M.t = struct type t = M.t end @@ -6916,10 +6904,9 @@ end type 'a tree = E | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor - (X : ORD) - -> SET with type t = X.t tree and type elt = X.t) : - SET with type elt = int = struct + (MakeDiet : functor (X : ORD) -> SET + with type t = X.t tree and type elt = X.t) : SET with type elt = int = +struct type elt = int module rec Elt : sig @@ -6941,7 +6928,7 @@ module Bootstrap2 | D (_, d, _) -> Diet.iter (iter f) d end - and Diet : (SET with type t = Elt.t tree and type elt = Elt.t) = + and Diet : SET with type t = Elt.t tree and type elt = Elt.t = MakeDiet (Elt) type t = Diet.t @@ -7025,7 +7012,7 @@ module PR_4557 = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end end @@ -7059,7 +7046,7 @@ module F (X : Set.OrderedType) = struct let compare x y = 0 end - and ModSet : (Set.S with type elt = Mod.t) = Set.Make (Mod) + and ModSet : Set.S with type elt = Mod.t = Set.Make (Mod) end (* Tests for recursive modules *) @@ -7085,7 +7072,7 @@ end = struct | Node s, Node t -> ASet.compare s t end -and ASet : (Set.S with type elt = A.t) = Set.Make (A) +and ASet : Set.S with type elt = A.t = Set.Make (A) let _ = let x = A.Node (ASet.add (A.Leaf 3) (ASet.singleton (A.Leaf 2))) in @@ -7341,8 +7328,8 @@ module type HEAP = sig end module Bootstrap - (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct + (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) + (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig @@ -7378,7 +7365,7 @@ module Bootstrap | E, E -> false end - and PrimH : (HEAP with type Elem.t = BE.t) = MakeH (BE) + and PrimH : HEAP with type Elem.t = BE.t = MakeH (BE) type heap = BE.t @@ -7554,8 +7541,7 @@ let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig val f : int -> int -end) = -struct +end) = struct let x = 0 let at a = A.f a @@ -7597,8 +7583,7 @@ let _ = (* PR#4316 *) module G (S : sig val x : int Lazy.t -end) = -struct +end) = struct include S end @@ -7677,8 +7662,7 @@ end module F (X : sig val x : (module S) -end) = -struct +end) = struct module A = (val X.x) end @@ -7956,7 +7940,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : AST with module Value := Value + module Ast : (AST with module Value := Value) type state = Value.state @@ -7978,7 +7962,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : PARSER with type chunk = Ast.chunk + module Parser : (PARSER with type chunk = Ast.chunk) val dostring : state -> string -> value list @@ -8006,9 +7990,9 @@ module type COMBINED_COMMON = sig type t end - module TV1 : TYPEVIEW with type combined := T.t + module TV1 : (TYPEVIEW with type combined := T.t) - module TV2 : TYPEVIEW with type combined := T.t + module TV2 : (TYPEVIEW with type combined := T.t) end module type COMBINED_TYPE = sig @@ -8035,7 +8019,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : USERTYPE with type t = t + module T : (USERTYPE with type t = t) module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end @@ -8052,8 +8036,7 @@ module type S = sig module M : sig type t end -end -with module M = M +end with module M = M module type Printable = sig type t @@ -8132,8 +8115,7 @@ module type S' = S with module T := M module type S = sig type 'a t -end -with type 'a t := unit +end with type 'a t := unit (* Fails *) let property (type t) () = From c63dfc6eabafacbb4aa8008b07843ccd86db5d21 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 16:04:04 +0200 Subject: [PATCH 09/26] Remove unecessary parentheses around Pmty_with --- lib/Ast.ml | 16 ++++++++-------- lib/Ast.mli | 2 +- lib/Fmt_ast.ml | 6 +++--- test/passing/tests/js_source.ml.ocp | 10 +++++----- test/passing/tests/js_source.ml.ref | 10 +++++----- test/passing/tests/source.ml.ref | 10 +++++----- 6 files changed, 27 insertions(+), 27 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index 46446e6772..f741f2161c 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -624,7 +624,7 @@ module T = struct | Exp of expression | Lb of let_binding | Mb of module_binding - | Md of module_declaration + | Md of module_declaration * bool (** Recursive *) | Cl of class_expr | Mty of module_type | Mod of module_expr @@ -644,7 +644,7 @@ module T = struct | Exp e -> Format.fprintf fs "Exp:@\n%a" Printast.expression e | Lb b -> Format.fprintf fs "Lb:@\n%a" Printast.let_binding b | Mb m -> Format.fprintf fs "Mb:@\n%a" Printast.module_binding m - | Md m -> Format.fprintf fs "Md:@\n%a" Printast.module_declaration m + | Md (m, _) -> Format.fprintf fs "Md:@\n%a" Printast.module_declaration m | Cl cl -> Format.fprintf fs "Cl:@\n%a" Printast.class_expr cl | Mty mt -> Format.fprintf fs "Mty:@\n%a" Printast.module_type mt | Cty cty -> Format.fprintf fs "Cty:@\n%a" Printast.class_type cty @@ -674,7 +674,7 @@ let attributes = function | Exp x -> x.pexp_attributes | Lb x -> x.lb_attributes | Mb x -> x.pmb_attributes - | Md x -> x.pmd_attributes + | Md (x, _) -> x.pmd_attributes | Cl x -> x.pcl_attributes | Mty x -> x.pmty_attributes | Mod x -> x.pmod_attributes @@ -695,7 +695,7 @@ let location = function | Exp x -> x.pexp_loc | Lb x -> x.lb_loc | Mb x -> x.pmb_loc - | Md x -> x.pmd_loc + | Md (x, _) -> x.pmd_loc | Cl x -> x.pcl_loc | Mty x -> x.pmty_loc | Mod x -> x.pmod_loc @@ -724,7 +724,7 @@ let break_between s cc (i1, c1) (i2, c2) = | Sig i1, Sig i2 -> Signature_item.break_between s cc (i1, c1) (i2, c2) | Lb i1, Lb i2 -> Lb.break_between s cc (i1, c1) (i2, c2) | Mb i1, Mb i2 -> Mb.break_between s cc (i1, c1) (i2, c2) - | Md i1, Md i2 -> Md.break_between s cc (i1, c1) (i2, c2) + | Md (i1, _), Md (i2, _) -> Md.break_between s cc (i1, c1) (i2, c2) | Mty _, Mty _ -> break_between_modules s cc (i1, c1) (i2, c2) | Mod _, Mod _ -> break_between_modules s cc (i1, c1) (i2, c2) | Tli (`Item i1), Tli (`Item i2) -> @@ -1791,9 +1791,9 @@ end = struct let parenze_mty {ctx; ast= mty} = match (ctx, mty.pmty_desc) with | _, (Pmty_ident _ | Pmty_extension _ | Pmty_signature _) -> false - (* [Pmty_with] must be parenthesed when on the RHS of a recursive module - decl. This is an over-approximation. *) - | Md _, Pmty_with _ -> true + (* [Pmty_with] must be parenthesed when on the RHS of a module decl + followed by an [and]. This is an over-approximation. *) + | Md (_, true), Pmty_with _ -> true | (Str _ | Sig _), _ -> false | _ -> Mty.has_trailing_attributes mty diff --git a/lib/Ast.mli b/lib/Ast.mli index f261826ede..a16dcc5ae6 100644 --- a/lib/Ast.mli +++ b/lib/Ast.mli @@ -112,7 +112,7 @@ type t = | Exp of expression | Lb of let_binding | Mb of module_binding - | Md of module_declaration + | Md of module_declaration * bool (** Recursive *) | Cl of class_expr | Mty of module_type | Mod of module_expr diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 8d4f3efa1b..0dfb6fc965 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3535,7 +3535,7 @@ and fmt_signature_item c ?ext {ast= si; _} = | Psig_recmodule mds -> fmt_recmodule c ctx mds (fmt_module_declaration ?ext) - (fun x -> Md x) + (fun x -> Md (x, true)) sub_md | Psig_type (rec_flag, decls) -> fmt_type c ?ext rec_flag decls ctx | Psig_typext te -> fmt_type_extension ?ext c ctx te @@ -3699,12 +3699,12 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") $ epi ) ) and fmt_module_declaration ?ext c ~rec_flag ~first {ast= pmd; _} = - protect c (Md pmd) + let ctx = Md (pmd, rec_flag) in + protect c ctx @@ let {pmd_name; pmd_args; pmd_type; pmd_attributes; pmd_loc} = pmd in update_config_maybe_disabled c pmd_loc pmd_attributes @@ fun c -> - let ctx = Md pmd in let ext = if first then ext else None in let keyword = if first then "module" else "and" in let xmty = sub_mty ~ctx pmd_type in diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index c5d9c3df68..01a41d3b92 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -8199,7 +8199,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : (AST with module Value := Value) + module Ast : AST with module Value := Value type state = Value.state type value = Value.value @@ -8219,7 +8219,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : (PARSER with type chunk = Ast.chunk) + module Parser : PARSER with type chunk = Ast.chunk val dostring : state -> string -> value list val mk : unit -> state @@ -8244,8 +8244,8 @@ module type COMBINED_COMMON = sig type t end - module TV1 : (TYPEVIEW with type combined := T.t) - module TV2 : (TYPEVIEW with type combined := T.t) + module TV1 : TYPEVIEW with type combined := T.t + module TV2 : TYPEVIEW with type combined := T.t end module type COMBINED_TYPE = sig @@ -8271,7 +8271,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : (USERTYPE with type t = t) + module T : USERTYPE with type t = t module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index d822c698fc..214f646027 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -8199,7 +8199,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : (AST with module Value := Value) + module Ast : AST with module Value := Value type state = Value.state type value = Value.value @@ -8219,7 +8219,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : (PARSER with type chunk = Ast.chunk) + module Parser : PARSER with type chunk = Ast.chunk val dostring : state -> string -> value list val mk : unit -> state @@ -8244,8 +8244,8 @@ module type COMBINED_COMMON = sig type t end - module TV1 : (TYPEVIEW with type combined := T.t) - module TV2 : (TYPEVIEW with type combined := T.t) + module TV1 : TYPEVIEW with type combined := T.t + module TV2 : TYPEVIEW with type combined := T.t end module type COMBINED_TYPE = sig @@ -8271,7 +8271,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : (USERTYPE with type t = t) + module T : USERTYPE with type t = t module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 4d704583d0..0bd2a10b3a 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -7940,7 +7940,7 @@ end module type EVALUATOR = sig module Value : VALUE - module Ast : (AST with module Value := Value) + module Ast : AST with module Value := Value type state = Value.state @@ -7962,7 +7962,7 @@ end module type INTERP = sig include EVALUATOR - module Parser : (PARSER with type chunk = Ast.chunk) + module Parser : PARSER with type chunk = Ast.chunk val dostring : state -> string -> value list @@ -7990,9 +7990,9 @@ module type COMBINED_COMMON = sig type t end - module TV1 : (TYPEVIEW with type combined := T.t) + module TV1 : TYPEVIEW with type combined := T.t - module TV2 : (TYPEVIEW with type combined := T.t) + module TV2 : TYPEVIEW with type combined := T.t end module type COMBINED_TYPE = sig @@ -8019,7 +8019,7 @@ end module type WEAPON_LIB = sig type t = Weapon.t - module T : (USERTYPE with type t = t) + module T : USERTYPE with type t = t module Make : functor (TV : TYPEVIEW with type t = t) -> USERCODE(TV).F end From dfdba8ebcb9245fe1242e0d7e755e378d24debfa Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 16:17:32 +0200 Subject: [PATCH 10/26] Restore docking of functor arguments --- lib/Fmt_ast.ml | 6 ++++-- lib/Params.ml | 7 +++++++ lib/Params.mli | 6 ++++++ test/passing/tests/js_source.ml.err | 12 ++++++------ test/passing/tests/js_source.ml.ocp | 5 ++--- test/passing/tests/js_source.ml.ref | 5 ++--- test/passing/tests/shortcut_ext_attr.ml | 5 +---- test/passing/tests/source.ml.err | 4 ++-- test/passing/tests/source.ml.ref | 5 +---- test/passing/tests/wrapping_functor_args.ml | 3 +-- 10 files changed, 32 insertions(+), 26 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 0dfb6fc965..72c6e2e04d 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3447,8 +3447,10 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t $ list args "@ " (fmt_functor_param c ctx) $ fmt " ->" ) $ fmt "@ " - in - fmt_module_type c ~box ~pro (sub_mty ~ctx mt) $ epi ~attr:false + and epi = epi ~attr:false in + if Params.Mty.dock_functor_rhs c.conf ~rhs:mt then + fmt_module_type c ~box ~pro ~epi (sub_mty ~ctx mt) + else hovbox_if box 2 (pro $ fmt_module_type c (sub_mty ~ctx mt) $ epi) | Pmty_with _ -> let wcs, mt = Sugar.mod_with (sub_mty ~ctx mty) in let fmt_cstr ~first ~last:_ wc = diff --git a/lib/Params.ml b/lib/Params.ml index 4043bb70c1..91c4c86d40 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -105,6 +105,13 @@ module Mod = struct {dock; arg_psp; indent; align} end +module Mty = struct + let dock_functor_rhs (_c : Conf.t) ~rhs = + match rhs.pmty_desc with + | Pmty_signature _ | Pmty_with _ -> true + | _ -> false +end + let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t) ~ctx = let nspaces = if cmts_before then 1000 else 1 in diff --git a/lib/Params.mli b/lib/Params.mli index 0f7f31d1de..4fac96f850 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -48,6 +48,12 @@ module Mod : sig val get_args : Conf.t -> functor_parameter loc list -> args end +module Mty : sig + val dock_functor_rhs : Conf.t -> rhs:module_type -> bool + (** Whether functor types should be docked on the same line or break after + the [->]. *) +end + val get_or_pattern_sep : ?cmts_before:bool -> ?space:bool -> Conf.t -> ctx:Ast.t -> Fmt.t diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 20046f6e4a..67a409e731 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ -Warning: tests/js_source.ml:3553 exceeds the margin -Warning: tests/js_source.ml:9507 exceeds the margin -Warning: tests/js_source.ml:9610 exceeds the margin -Warning: tests/js_source.ml:9629 exceeds the margin -Warning: tests/js_source.ml:9669 exceeds the margin -Warning: tests/js_source.ml:9753 exceeds the margin +Warning: tests/js_source.ml:3552 exceeds the margin +Warning: tests/js_source.ml:9506 exceeds the margin +Warning: tests/js_source.ml:9609 exceeds the margin +Warning: tests/js_source.ml:9628 exceeds the margin +Warning: tests/js_source.ml:9668 exceeds the margin +Warning: tests/js_source.ml:9752 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 01a41d3b92..469bc949e8 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -154,9 +154,8 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> -sig end -[@foo] +module type S = functor [@foo] (M : S) -> + functor (_ : (module type of M) [@foo]) -> sig end [@foo] module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 214f646027..70759244ac 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -154,9 +154,8 @@ type t = [%foo: ((module M)[@foo])] module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) -module type S = functor [@foo] (M : S) -> functor (_ : (module type of M) [@foo]) -> - sig end - [@foo] +module type S = functor [@foo] (M : S) -> + functor (_ : (module type of M) [@foo]) -> sig end [@foo] module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S diff --git a/test/passing/tests/shortcut_ext_attr.ml b/test/passing/tests/shortcut_ext_attr.ml index 44bdcd89f0..81e198b967 100644 --- a/test/passing/tests/shortcut_ext_attr.ml +++ b/test/passing/tests/shortcut_ext_attr.ml @@ -79,10 +79,7 @@ module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) module type S = functor [@foo1] (M : S) -> - functor - (_ : (module type of M) [@foo2]) -> - sig end - [@foo3] + functor (_ : (module type of M) [@foo2]) -> sig end [@foo3] (* Structure items *) let%foo[@foo] x = 4 diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 50f7e55a5d..962fc1601f 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,2 +1,2 @@ -Warning: tests/source.ml:702 exceeds the margin -Warning: tests/source.ml:2318 exceeds the margin +Warning: tests/source.ml:699 exceeds the margin +Warning: tests/source.ml:2315 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 0bd2a10b3a..133dbb2c56 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -182,10 +182,7 @@ module M = (functor [@foo] (M : S) -> (val x) [@foo] (struct end [@foo])) (* Module type expression *) module type S = functor [@foo] (M : S) -> - functor - (_ : (module type of M) [@foo]) -> - sig end - [@foo] + functor (_ : (module type of M) [@foo]) -> sig end [@foo] module type S = functor (_ : S) (_ : S) -> S diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 16ea5dc32b..03ee17f302 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -1,8 +1,7 @@ module F3 (G : functor (_ : T____________________________________________) - (_ : T____________________________________________) -> - T) + (_ : T____________________________________________) -> T) (A : sig val x : int end) = struct end From 1c97787ebdb582d907433f3cd314dde5934aca5b Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 16:32:14 +0200 Subject: [PATCH 11/26] Restore break between `= struct` in some cases --- lib/Fmt_ast.ml | 4 +- test/passing/tests/functor.ml | 3 +- test/passing/tests/hash_types.ml | 3 +- test/passing/tests/injectivity.ml | 9 ++-- test/passing/tests/js_source.ml.err | 12 ++--- test/passing/tests/js_source.ml.ocp | 51 ++++++++++++++------- test/passing/tests/js_source.ml.ref | 51 ++++++++++++++------- test/passing/tests/source.ml.ref | 51 ++++++++++++++------- test/passing/tests/wrapping_functor_args.ml | 3 +- 9 files changed, 123 insertions(+), 64 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 72c6e2e04d..344040bd20 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3680,7 +3680,9 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") (if compact then 0 else 2) ( doc_before $ blk_box blk_b - ( hovbox 0 + (* Avod break after [=] if there was a module type. *) + ( (if Option.is_some xmty then hovbox else hvbox) + 0 ( fmt_mty $ fmt_if (Option.is_some xbody) " =" $ fmt_if_k compact fmt_pro ) diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml index 0d1b8bf9d6..1ffda5711f 100644 --- a/test/passing/tests/functor.ml +++ b/test/passing/tests/functor.ml @@ -76,7 +76,8 @@ module Make and type semantic_value = Obj.t) (E : sig type 'a env = (ET.state, ET.semantic_value, ET.token) EngineTypes.env - end) = struct + end) = +struct type t = t end diff --git a/test/passing/tests/hash_types.ml b/test/passing/tests/hash_types.ml index 2e040177ee..a2f551ab00 100644 --- a/test/passing/tests/hash_types.ml +++ b/test/passing/tests/hash_types.ml @@ -1,6 +1,7 @@ module F (X : sig type t -end) = struct +end) = +struct class type ['a] c = object method m : 'a -> X.t end diff --git a/test/passing/tests/injectivity.ml b/test/passing/tests/injectivity.ml index 76291b1fa3..ea909bba79 100644 --- a/test/passing/tests/injectivity.ml +++ b/test/passing/tests/injectivity.ml @@ -60,19 +60,22 @@ type !'a u = int constraint 'a = 'b t module F (X : sig type 'a t -end) = struct +end) = +struct type !'a u = 'b constraint 'a = < b: 'b > constraint 'b = _ X.t end module F (X : sig type 'a t -end) = struct +end) = +struct type !'a u = 'b X.t constraint 'a = < b: 'b X.t > end module F (X : sig type 'a t -end) = struct +end) = +struct type !'a u = 'b constraint 'a = < b: (_ X.t as 'b) > end diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 67a409e731..373c13a1bf 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ -Warning: tests/js_source.ml:3552 exceeds the margin -Warning: tests/js_source.ml:9506 exceeds the margin -Warning: tests/js_source.ml:9609 exceeds the margin -Warning: tests/js_source.ml:9628 exceeds the margin -Warning: tests/js_source.ml:9668 exceeds the margin -Warning: tests/js_source.ml:9752 exceeds the margin +Warning: tests/js_source.ml:3558 exceeds the margin +Warning: tests/js_source.ml:9523 exceeds the margin +Warning: tests/js_source.ml:9626 exceeds the margin +Warning: tests/js_source.ml:9645 exceeds the margin +Warning: tests/js_source.ml:9685 exceeds the margin +Warning: tests/js_source.ml:9769 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 469bc949e8..afbf993cb0 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -2366,7 +2366,8 @@ let inlineseq_from_astseq seq = module Add (T : sig type two - end) = struct + end) = +struct type _ t = | One : [ `One ] t | Two : T.two t @@ -2451,7 +2452,8 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig type 'a t - end) = struct + end) = +struct type _ ab = | A : int S.t ab | B : float S.t ab @@ -2465,7 +2467,8 @@ end module F (S : sig type 'a t - end) = struct + end) = +struct type a = int * int type b = int -> int @@ -2568,7 +2571,8 @@ let f : (int s, int t) eq -> unit = function module M (S : sig type 'a t = T of 'a type 'a s = T of 'a - end) = struct + end) = +struct let f : ('a S.s, 'a S.t) eq -> unit = function | Refl -> () ;; @@ -2609,7 +2613,8 @@ module M end) (B : sig module type T - end) = struct + end) = +struct let f : ((module A.T), (module B.T)) t -> string = function | B s -> s ;; @@ -2807,7 +2812,8 @@ let f (type a) (Neq n : (a, a t) eq) = n module F (T : sig type _ t - end) = struct + end) = +struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -4689,7 +4695,8 @@ module F (M : sig type 'a u = string val f : unit -> _ u t - end) = struct + end) = +struct let t = M.f () end @@ -4743,7 +4750,8 @@ module F module type T end) (A : S.T) - (B : S.T) = struct + (B : S.T) = +struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4953,7 +4961,8 @@ end module Foo (Bar : S with type a = private [> `A ]) - (Baz : S with type b = private < b : Bar.b ; .. >) = struct end + (Baz : S with type b = private < b : Bar.b ; .. >) = +struct end module A = struct module type A_S = sig end @@ -4991,7 +5000,8 @@ module Foo (Baz : module type of struct include Bar - end) = struct end + end) = +struct end module Bazoinks = struct type a = [ `A ] @@ -5006,7 +5016,8 @@ let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig type 'a f - end) = struct + end) = +struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5529,7 +5540,8 @@ include C module F (X : sig module C = Char - end) = struct + end) = +struct module C = X.C end @@ -5593,7 +5605,8 @@ module F end) (M : sig type t = Y.t - end) = struct end + end) = +struct end module G = F (M.Y) @@ -6674,7 +6687,8 @@ class ['a] s3object r : ['a] s3 = module M (T : sig type t - end) = struct + end) = +struct type t = private { t : T.t } end @@ -7794,7 +7808,8 @@ let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig val f : int -> int - end) = struct + end) = +struct let x = 0 let at a = A.f a end @@ -7841,7 +7856,8 @@ let _ = (* PR#4316 *) module G (S : sig val x : int Lazy.t - end) = struct + end) = +struct include S end @@ -7934,7 +7950,8 @@ end module F (X : sig val x : (module S) - end) = struct + end) = +struct module A = (val X.x) end diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 70759244ac..90aa07fe67 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -2366,7 +2366,8 @@ let inlineseq_from_astseq seq = module Add (T : sig type two -end) = struct +end) = +struct type _ t = | One : [ `One ] t | Two : T.two t @@ -2451,7 +2452,8 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig type 'a t -end) = struct +end) = +struct type _ ab = | A : int S.t ab | B : float S.t ab @@ -2465,7 +2467,8 @@ end module F (S : sig type 'a t -end) = struct +end) = +struct type a = int * int type b = int -> int @@ -2568,7 +2571,8 @@ let f : (int s, int t) eq -> unit = function module M (S : sig type 'a t = T of 'a type 'a s = T of 'a -end) = struct +end) = +struct let f : ('a S.s, 'a S.t) eq -> unit = function | Refl -> () ;; @@ -2609,7 +2613,8 @@ module M end) (B : sig module type T - end) = struct + end) = +struct let f : ((module A.T), (module B.T)) t -> string = function | B s -> s ;; @@ -2807,7 +2812,8 @@ let f (type a) (Neq n : (a, a t) eq) = n module F (T : sig type _ t -end) = struct +end) = +struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -4689,7 +4695,8 @@ module F (M : sig type 'a u = string val f : unit -> _ u t -end) = struct +end) = +struct let t = M.f () end @@ -4743,7 +4750,8 @@ module F module type T end) (A : S.T) - (B : S.T) = struct + (B : S.T) = +struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4953,7 +4961,8 @@ end module Foo (Bar : S with type a = private [> `A ]) - (Baz : S with type b = private < b : Bar.b ; .. >) = struct end + (Baz : S with type b = private < b : Bar.b ; .. >) = +struct end module A = struct module type A_S = sig end @@ -4991,7 +5000,8 @@ module Foo (Baz : module type of struct include Bar - end) = struct end + end) = +struct end module Bazoinks = struct type a = [ `A ] @@ -5006,7 +5016,8 @@ let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig type 'a f -end) = struct +end) = +struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5529,7 +5540,8 @@ include C module F (X : sig module C = Char -end) = struct +end) = +struct module C = X.C end @@ -5593,7 +5605,8 @@ module F end) (M : sig type t = Y.t - end) = struct end + end) = +struct end module G = F (M.Y) @@ -6674,7 +6687,8 @@ class ['a] s3object r : ['a] s3 = module M (T : sig type t -end) = struct +end) = +struct type t = private { t : T.t } end @@ -7794,7 +7808,8 @@ let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig val f : int -> int -end) = struct +end) = +struct let x = 0 let at a = A.f a end @@ -7841,7 +7856,8 @@ let _ = (* PR#4316 *) module G (S : sig val x : int Lazy.t -end) = struct +end) = +struct include S end @@ -7934,7 +7950,8 @@ end module F (X : sig val x : (module S) -end) = struct +end) = +struct module A = (val X.x) end diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 133dbb2c56..9d68085204 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -2337,7 +2337,8 @@ let inlineseq_from_astseq seq = module Add (T : sig type two -end) = struct +end) = +struct type _ t = One : [`One] t | Two : T.two t let add (type a) : a t * a t -> string = function @@ -2400,7 +2401,8 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) module F (S : sig type 'a t -end) = struct +end) = +struct type _ ab = A : int S.t ab | B : float S.t ab let f : int S.t ab -> float S.t ab -> string = @@ -2410,7 +2412,8 @@ end module F (S : sig type 'a t -end) = struct +end) = +struct type a = int * int type b = int -> int @@ -2497,7 +2500,8 @@ module M (S : sig type 'a t = T of 'a type 'a s = T of 'a -end) = struct +end) = +struct let f : ('a S.s, 'a S.t) eq -> unit = function Refl -> () end @@ -2527,7 +2531,8 @@ module M (A : sig module type T end) (B : sig module type T -end) = struct +end) = +struct let f : ((module A.T), (module B.T)) t -> string = function B s -> s end @@ -2702,7 +2707,8 @@ let f (type a) (Neq n : (a, a t) eq) = n module F (T : sig type _ t -end) = struct +end) = +struct let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) end @@ -4439,7 +4445,8 @@ module F (M : sig type 'a u = string val f : unit -> _ u t -end) = struct +end) = +struct let t = M.f () end @@ -4496,7 +4503,8 @@ module F module type T end) (A : S.T) - (B : S.T) = struct + (B : S.T) = +struct module X = (val if !flag then (module A) else (module B) : S.T) end @@ -4700,7 +4708,8 @@ end module Foo (Bar : S with type a = private [> `A]) - (Baz : S with type b = private < b: Bar.b ; .. >) = struct end + (Baz : S with type b = private < b: Bar.b ; .. >) = +struct end module A = struct module type A_S = sig end @@ -4743,7 +4752,8 @@ module Foo (Bar : sig end) (Baz : module type of struct include Bar - end) = struct end + end) = +struct end module Bazoinks = struct type a = [`A] @@ -4758,7 +4768,8 @@ let cast : type a b. (a, b) eq -> a -> b = fun Eq x -> x module Fix (F : sig type 'a f -end) = struct +end) = +struct type 'a fix = ('a, 'a F.f) eq let uniq (type a b) (Eq : a fix) (Eq : b fix) : (a, b) eq = Eq @@ -5280,7 +5291,8 @@ include C module F (X : sig module C = Char -end) = struct +end) = +struct module C = X.C end @@ -5344,7 +5356,8 @@ module F (Y : sig type t end) (M : sig type t = Y.t -end) = struct end +end) = +struct end module G = F (M.Y) @@ -6433,7 +6446,8 @@ class ['a] s3object r : ['a] s3 = module M (T : sig type t -end) = struct +end) = +struct type t = private {t: T.t} end @@ -7538,7 +7552,8 @@ let _ = test 81 (Coerce2.f1 ()) 1 module Coerce4 (A : sig val f : int -> int -end) = struct +end) = +struct let x = 0 let at a = A.f a @@ -7580,7 +7595,8 @@ let _ = (* PR#4316 *) module G (S : sig val x : int Lazy.t -end) = struct +end) = +struct include S end @@ -7659,7 +7675,8 @@ end module F (X : sig val x : (module S) -end) = struct +end) = +struct module A = (val X.x) end diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 03ee17f302..7a4e1b516e 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -4,4 +4,5 @@ module F3 (_ : T____________________________________________) -> T) (A : sig val x : int - end) = struct end + end) = +struct end From 591ddb846a4bda2152f6958b9f73ddafbbfa1abf Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 16:41:23 +0200 Subject: [PATCH 12/26] Restore formatting of module arguments --- lib/Fmt_ast.ml | 19 ++++++++++--------- test/passing/tests/doc_comments-after.ml.ref | 12 ++++++------ .../doc_comments-before-except-val.ml.ref | 12 ++++++------ test/passing/tests/doc_comments-before.ml.ref | 12 ++++++------ test/passing/tests/doc_comments.ml.ref | 12 ++++++------ test/passing/tests/js_source.ml.err | 2 +- test/passing/tests/js_source.ml.ocp | 6 +++--- test/passing/tests/js_source.ml.ref | 6 +++--- test/passing/tests/source.ml.err | 4 ++-- test/passing/tests/source.ml.ref | 11 +++++------ 10 files changed, 48 insertions(+), 48 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 344040bd20..936b02a1a7 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3665,16 +3665,17 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") attributes in let fmt_mty = - let args = - if args_p.dock then fmt_args_docked ~pro:intro xargs - else intro $ fmt_args_wrapped xargs + let args ~epi = + hvbox args_p.indent + ( ( if args_p.dock then fmt_args_docked ~pro:intro xargs + else intro $ fmt_args_wrapped xargs ) + $ epi ) in - hvbox args_p.indent - ( match xmty with - | Some xmty -> - let pro = args $ str " " $ str eqty $ str " " in - fmt_module_type ~pro c xmty - | None -> args ) + match xmty with + | Some xmty -> + let pro = args ~epi:(str " " $ str eqty $ str " ") in + fmt_module_type ~pro c xmty + | None -> args ~epi:noop in hvbox (if compact then 0 else 2) diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index fab197cc31..fdacc13e71 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -119,12 +119,12 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 99fabe29d9..59a6180c19 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -119,12 +119,12 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index ed72dafd1a..efa518581f 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -119,12 +119,12 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 99fabe29d9..59a6180c19 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -119,12 +119,12 @@ module Comment_placement : sig (** This one _still_ goes after *) module Index2 - (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) - (Foo : BAR) : sig end + (Paramater_module : BAR_LONG_MODULE_TYPE_NAME) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 373c13a1bf..d8ebf24e5f 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,4 +1,4 @@ -Warning: tests/js_source.ml:3558 exceeds the margin +Warning: tests/js_source.ml:3557 exceeds the margin Warning: tests/js_source.ml:9523 exceeds the margin Warning: tests/js_source.ml:9626 exceeds the margin Warning: tests/js_source.ml:9645 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index afbf993cb0..c9e36c4111 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -564,8 +564,7 @@ module Msg : sig val read : string -> t end - module Define - (D : Desc) : sig + module Define (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -7574,7 +7573,8 @@ module type HEAP = sig val deleteMin : heap -> heap end -module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) +module Bootstrap + (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 90aa07fe67..25cdece536 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -564,8 +564,7 @@ module Msg : sig val read : string -> t end - module Define - (D : Desc) : sig + module Define (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -7574,7 +7573,8 @@ module type HEAP = sig val deleteMin : heap -> heap end -module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) +module Bootstrap + (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 962fc1601f..62c2a32678 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,2 +1,2 @@ -Warning: tests/source.ml:699 exceeds the margin -Warning: tests/source.ml:2315 exceeds the margin +Warning: tests/source.ml:698 exceeds the margin +Warning: tests/source.ml:2314 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 9d68085204..3e7d58de9d 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -654,8 +654,7 @@ module Msg : sig val read : string -> t end - module Define - (D : Desc) : sig + module Define (D : Desc) : sig type 'a tag += C : D.t tag end end = struct @@ -6915,8 +6914,8 @@ end type 'a tree = E | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET - with type t = X.t tree and type elt = X.t) : SET with type elt = int = + (MakeDiet : functor (X : ORD) -> SET + with type t = X.t tree and type elt = X.t) : SET with type elt = int = struct type elt = int @@ -7339,8 +7338,8 @@ module type HEAP = sig end module Bootstrap - (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct + (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) + (Element : ORDERED) : HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig From a38db960ec31f52ae222e1661754effe06e05a53 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 16:47:05 +0200 Subject: [PATCH 13/26] Remove parenthesis around functor types with attributes These attributes are always formatted in short form and are never trailing. --- lib/Ast.ml | 2 ++ test/passing/tests/generative.ml.ref | 2 +- test/passing/tests/js_source.ml.ocp | 4 ++-- test/passing/tests/js_source.ml.ref | 4 ++-- test/passing/tests/source.ml | 3 +++ test/passing/tests/source.ml.ref | 7 +++++-- 6 files changed, 15 insertions(+), 7 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index f741f2161c..79822e2600 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -1791,6 +1791,8 @@ end = struct let parenze_mty {ctx; ast= mty} = match (ctx, mty.pmty_desc) with | _, (Pmty_ident _ | Pmty_extension _ | Pmty_signature _) -> false + (* Currently, attributes on a [Pmty_functor] are always in short form. *) + | _, Pmty_functor _ -> false (* [Pmty_with] must be parenthesed when on the RHS of a module decl followed by an [and]. This is an over-approximation. *) | Md (_, true), Pmty_with _ -> true diff --git a/test/passing/tests/generative.ml.ref b/test/passing/tests/generative.ml.ref index 700640fe35..bd22c02221 100644 --- a/test/passing/tests/generative.ml.ref +++ b/test/passing/tests/generative.ml.ref @@ -9,7 +9,7 @@ module F2 : functor () () -> sig end = F1 module F2 : (*xx*) functor ( (*yy*) ) (*zz*) -> sig end = F1 -module F2 : functor () -> (functor [@attr] () () -> sig end) = F1 +module F2 : functor () -> functor [@attr] () () -> sig end = F1 module F2 : functor () () () () -> sig end = F1 diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index c9e36c4111..af96a6252e 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -161,8 +161,8 @@ module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S -module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S +module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S +module type S = functor (_ : functor [@foo] (M : S) -> S) -> S module type S = sig module rec A : (S with type t = t) diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 25cdece536..896c3036a0 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -161,8 +161,8 @@ module type S = functor (_ : S) (_ : S) -> S module type S = functor (_ : functor (_ : S) -> S) -> S module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S -module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S +module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S +module type S = functor (_ : functor [@foo] (M : S) -> S) -> S module type S = sig module rec A : (S with type t = t) diff --git a/test/passing/tests/source.ml b/test/passing/tests/source.ml index 7d764f9e4d..90f0fe1f92 100644 --- a/test/passing/tests/source.ml +++ b/test/passing/tests/source.ml @@ -7423,3 +7423,6 @@ let () = | _ -> ()) | _ -> () ;; + +(* Long-form attribute on a functor module type expr. *) +module type S = functor (A : B) -> (functor (C : D) -> S') [@foo] diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 3e7d58de9d..6cb8100081 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -192,9 +192,9 @@ module type S = functor (M : S) (_ : S) -> S module type S = functor (_ : functor (M : S) -> S) -> S -module type S = functor (_ : (functor [@foo] (_ : S) -> S)) -> S +module type S = functor (_ : functor [@foo] (_ : S) -> S) -> S -module type S = functor (_ : (functor [@foo] (M : S) -> S)) -> S +module type S = functor (_ : functor [@foo] (M : S) -> S) -> S module type S = sig module rec A : (S with type t = t) @@ -9184,3 +9184,6 @@ let eradicate_meta_class_is_nullsafe = let () = match () with _ -> ( fun _ : _ -> match () with _ -> () ) | _ -> () + +(* Long-form attribute on a functor module type expr. *) +module type S = functor (A : B) -> functor [@foo] (C : D) -> S' From 1641a65de4e51c6f3077da44567f83ed464e64eb Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 17:22:01 +0200 Subject: [PATCH 14/26] Break before module type that follow breaking arguments The module type is hard to read on the right of a module argument, which can grow complex. --- lib/Fmt_ast.ml | 3 ++- test/passing/tests/doc_comments-after.ml.err | 2 +- test/passing/tests/doc_comments-after.ml.ref | 3 ++- .../tests/doc_comments-before-except-val.ml.err | 2 +- .../tests/doc_comments-before-except-val.ml.ref | 3 ++- test/passing/tests/doc_comments-before.ml.err | 2 +- test/passing/tests/doc_comments-before.ml.ref | 3 ++- test/passing/tests/doc_comments.ml.err | 2 +- test/passing/tests/doc_comments.ml.ref | 3 ++- test/passing/tests/js_source.ml.err | 10 +++++----- test/passing/tests/js_source.ml.ocp | 7 ++++--- test/passing/tests/js_source.ml.ref | 7 ++++--- test/passing/tests/source.ml.ref | 7 ++++--- 13 files changed, 31 insertions(+), 23 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 936b02a1a7..526bc38b93 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3673,7 +3673,8 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") in match xmty with | Some xmty -> - let pro = args ~epi:(str " " $ str eqty $ str " ") in + let break = if args_p.dock then str " " else fmt "@ " in + let pro = args ~epi:(str " " $ str eqty $ break) in fmt_module_type ~pro c xmty | None -> args ~epi:noop in diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err index dd738d90f3..50431af122 100644 --- a/test/passing/tests/doc_comments-after.ml.err +++ b/test/passing/tests/doc_comments-after.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:302 exceeds the margin diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index fdacc13e71..85a3f47920 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -124,7 +124,8 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : sig end + (Foo : BAR) : + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err index dd738d90f3..50431af122 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.err +++ b/test/passing/tests/doc_comments-before-except-val.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:302 exceeds the margin diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 59a6180c19..e89d620051 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -124,7 +124,8 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : sig end + (Foo : BAR) : + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err index dd738d90f3..50431af122 100644 --- a/test/passing/tests/doc_comments-before.ml.err +++ b/test/passing/tests/doc_comments-before.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:302 exceeds the margin diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index efa518581f..47e34264cc 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -124,7 +124,8 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : sig end + (Foo : BAR) : + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err index dd738d90f3..50431af122 100644 --- a/test/passing/tests/doc_comments.ml.err +++ b/test/passing/tests/doc_comments.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:301 exceeds the margin +Warning: tests/doc_comments.ml:302 exceeds the margin diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 59a6180c19..e89d620051 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -124,7 +124,8 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : sig end + (Foo : BAR) : + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index d8ebf24e5f..6e4ee891a4 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ Warning: tests/js_source.ml:3557 exceeds the margin -Warning: tests/js_source.ml:9523 exceeds the margin -Warning: tests/js_source.ml:9626 exceeds the margin -Warning: tests/js_source.ml:9645 exceeds the margin -Warning: tests/js_source.ml:9685 exceeds the margin -Warning: tests/js_source.ml:9769 exceeds the margin +Warning: tests/js_source.ml:9524 exceeds the margin +Warning: tests/js_source.ml:9627 exceeds the margin +Warning: tests/js_source.ml:9646 exceeds the margin +Warning: tests/js_source.ml:9686 exceeds the margin +Warning: tests/js_source.ml:9770 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index af96a6252e..b474ef582b 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -7141,8 +7141,8 @@ type 'a tree = | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : SET - with type elt = int = struct + (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : + SET with type elt = int = struct type elt = int module rec Elt : sig @@ -7575,7 +7575,8 @@ end module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct + (Element : ORDERED) : + HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 896c3036a0..68ceaf88a4 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -7141,8 +7141,8 @@ type 'a tree = | N of 'a tree * 'a * 'a tree module Bootstrap2 - (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : SET - with type elt = int = struct + (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : + SET with type elt = int = struct type elt = int module rec Elt : sig @@ -7575,7 +7575,8 @@ end module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct + (Element : ORDERED) : + HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 6cb8100081..597bae2e8a 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -6915,8 +6915,8 @@ type 'a tree = E | N of 'a tree * 'a * 'a tree module Bootstrap2 (MakeDiet : functor (X : ORD) -> SET - with type t = X.t tree and type elt = X.t) : SET with type elt = int = -struct + with type t = X.t tree and type elt = X.t) : + SET with type elt = int = struct type elt = int module rec Elt : sig @@ -7339,7 +7339,8 @@ end module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) - (Element : ORDERED) : HEAP with module Elem = Element = struct + (Element : ORDERED) : + HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig From 01cf935d47ae1a6307f0c762cc0b0130b8e6330f Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 17:23:45 +0200 Subject: [PATCH 15/26] Accept changed formatting of module with constraints --- lib-rpc/protocol.mli | 33 ++++++++++++++------------------- 1 file changed, 14 insertions(+), 19 deletions(-) diff --git a/lib-rpc/protocol.mli b/lib-rpc/protocol.mli index 7db30b222d..d67fa37bc5 100644 --- a/lib-rpc/protocol.mli +++ b/lib-rpc/protocol.mli @@ -37,23 +37,18 @@ module Make (IO : IO.S) : sig end (** Version used to set the protocol version *) - module Init : - Command_S with type t = [`Halt | `Unknown | `Version of string] - - module V1 : - Command_S - with type t = - [ `Halt - | `Unknown - | `Error of string - | `Config of (string * string) list - | `Format of string ] - - module V2 : - Command_S - with type t = - [ `Halt - | `Unknown - | `Error of string - | `Format of string * format_args ] + module Init : Command_S + with type t = [`Halt | `Unknown | `Version of string] + + module V1 : Command_S + with type t = + [ `Halt + | `Unknown + | `Error of string + | `Config of (string * string) list + | `Format of string ] + + module V2 : Command_S + with type t = + [`Halt | `Unknown | `Error of string | `Format of string * format_args] end From e78c45456f51cde2c486767d57e15c925d51b78a Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 24 May 2023 18:00:38 +0200 Subject: [PATCH 16/26] Dock large module type expr after a functor --- lib/Fmt_ast.ml | 8 +++++--- test/passing/tests/functor.ml | 3 +-- test/passing/tests/js_source.ml.err | 10 +++++----- test/passing/tests/js_source.ml.ocp | 3 +-- test/passing/tests/js_source.ml.ref | 3 +-- test/passing/tests/source.ml.err | 1 + test/passing/tests/source.ml.ref | 7 +++---- 7 files changed, 17 insertions(+), 18 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 526bc38b93..7df7ae1614 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3439,18 +3439,20 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false ) | Pmty_functor (args, mt) -> - let pro = + let intro = hvbox 2 ( pro $ str "functor" $ fmt_attributes c ~pre:Blank pmty_attributes $ fmt "@ " $ list args "@ " (fmt_functor_param c ctx) $ fmt " ->" ) - $ fmt "@ " and epi = epi ~attr:false in if Params.Mty.dock_functor_rhs c.conf ~rhs:mt then + let pro = intro $ str " " in fmt_module_type c ~box ~pro ~epi (sub_mty ~ctx mt) - else hovbox_if box 2 (pro $ fmt_module_type c (sub_mty ~ctx mt) $ epi) + else + let pro = intro $ fmt "@ " in + hovbox_if box 2 (pro $ fmt_module_type c (sub_mty ~ctx mt) $ epi) | Pmty_with _ -> let wcs, mt = Sugar.mod_with (sub_mty ~ctx mty) in let fmt_cstr ~first ~last:_ wc = diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml index 1ffda5711f..339fdfb32b 100644 --- a/test/passing/tests/functor.ml +++ b/test/passing/tests/functor.ml @@ -14,8 +14,7 @@ module type M = functor (S : S) () -> sig end module type M = functor (SSSSS : SSSSSSSSSSSSSS) - (TTTTT : TTTTTTTTTTTTTTTT) -> - sig + (TTTTT : TTTTTTTTTTTTTTTT) -> sig val t1 : a val t2 : b diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 6e4ee891a4..d8ebf24e5f 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ Warning: tests/js_source.ml:3557 exceeds the margin -Warning: tests/js_source.ml:9524 exceeds the margin -Warning: tests/js_source.ml:9627 exceeds the margin -Warning: tests/js_source.ml:9646 exceeds the margin -Warning: tests/js_source.ml:9686 exceeds the margin -Warning: tests/js_source.ml:9770 exceeds the margin +Warning: tests/js_source.ml:9523 exceeds the margin +Warning: tests/js_source.ml:9626 exceeds the margin +Warning: tests/js_source.ml:9645 exceeds the margin +Warning: tests/js_source.ml:9685 exceeds the margin +Warning: tests/js_source.ml:9769 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index b474ef582b..7fd1111d3e 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -5423,8 +5423,7 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> -sig +module G : functor (X : sig end) -> sig module N' : sig val x : int end diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 68ceaf88a4..4da18adac4 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -5423,8 +5423,7 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> - sig +module G : functor (X : sig end) -> sig module N' : sig val x : int end diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 62c2a32678..fb9bfa3aa7 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,2 +1,3 @@ Warning: tests/source.ml:698 exceeds the margin Warning: tests/source.ml:2314 exceeds the margin +Warning: tests/source.ml:8023 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 597bae2e8a..d1fe2af504 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -5174,8 +5174,7 @@ module F (X : sig end) = struct module N' = N end -module G : functor (X : sig end) -> - sig +module G : functor (X : sig end) -> sig module N' : sig val x : int end @@ -8022,8 +8021,8 @@ module type BARECODE = sig end module USERCODE (X : TYPEVIEW) = struct - module type F = functor (C : CORE with type V.usert = X.combined) -> - BARECODE with type state := C.V.state + module type F = functor (C : CORE with type V.usert = X.combined) -> BARECODE + with type state := C.V.state end module Weapon = struct From 0955f0a55fb59db3f9ef71ae09728df1100b12aa Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 5 Jul 2023 14:35:26 +0200 Subject: [PATCH 17/26] Avoid breaking before attributes of a sig --- lib/Fmt_ast.ml | 13 ++++++++----- test/passing/tests/js_source.ml.err | 12 ++++++------ test/passing/tests/js_source.ml.ocp | 3 +-- test/passing/tests/js_source.ml.ref | 3 +-- test/passing/tests/source.ml.err | 6 +++--- test/passing/tests/source.ml.ref | 3 +-- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 6471713110..a91bf4e6df 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3427,14 +3427,16 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t let empty = List.is_empty s && not (Cmts.has_within c.cmts pmty_loc) in (* Side effect before [epi ~attr] is important. *) let cmts_within = Cmts.fmt_within ~pro:noop c pmty_loc in + let has_attrs = not (List.is_empty pmty_attributes) in hvbox_if box 2 ( pro $ str "sig" $ (if empty then str " " else break 1000 0) $ cmts_within $ fmt_signature c ctx s $ (if empty then noop else break 1000 ~-2) - $ str "end" - $ fmt_attributes_and_docstrings c pmty_attributes - $ epi ~attr:false ) + $ hvbox_if has_attrs 0 + ( str "end" + $ fmt_attributes_and_docstrings c pmty_attributes + $ epi ~attr:false ) ) | Pmty_functor (args, mt) -> let intro = hvbox 2 @@ -3452,8 +3454,9 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t hovbox_if box 2 (pro $ fmt_module_type c (sub_mty ~ctx mt) $ epi) | Pmty_gen (gen_loc, mt) -> let pro = - pro $ Cmts.fmt c gen_loc (wrap "(" ")" (Cmts.fmt_within c gen_loc)) - $ fmt "@;<1 2>-> " + pro + $ Cmts.fmt c gen_loc (wrap "(" ")" (Cmts.fmt_within c gen_loc)) + $ fmt "@;<1 2>-> " in fmt_module_type c ~box ~pro (sub_mty ~ctx mt) $ epi ~attr:true | Pmty_with _ -> diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index e76bc2f0b3..888dd309c6 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ -Warning: tests/js_source.ml:3557 exceeds the margin -Warning: tests/js_source.ml:9523 exceeds the margin -Warning: tests/js_source.ml:9626 exceeds the margin -Warning: tests/js_source.ml:9645 exceeds the margin -Warning: tests/js_source.ml:9685 exceeds the margin -Warning: tests/js_source.ml:9767 exceeds the margin +Warning: tests/js_source.ml:3556 exceeds the margin +Warning: tests/js_source.ml:9522 exceeds the margin +Warning: tests/js_source.ml:9625 exceeds the margin +Warning: tests/js_source.ml:9644 exceeds the margin +Warning: tests/js_source.ml:9684 exceeds the margin +Warning: tests/js_source.ml:9766 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index c499f45552..2b202fa8e5 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -17,8 +17,7 @@ module type S = sig include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end - [@foo] +end [@foo] [@@foo] [@@@foo] diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index bb4aa8652c..71a9fe5990 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -17,8 +17,7 @@ module type S = sig include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end - [@foo] +end [@foo] [@@foo] [@@@foo] diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index fb9bfa3aa7..8b168c8703 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,3 +1,3 @@ -Warning: tests/source.ml:698 exceeds the margin -Warning: tests/source.ml:2314 exceeds the margin -Warning: tests/source.ml:8023 exceeds the margin +Warning: tests/source.ml:697 exceeds the margin +Warning: tests/source.ml:2313 exceeds the margin +Warning: tests/source.ml:8022 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 0f9eaf242b..3bdfaff335 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -17,8 +17,7 @@ module type S = sig include (module type of M [@foo]) [@foo] with type t := M.t [@foo] [@@foo] [@@@foo] -end - [@foo] +end [@foo] [@@foo] [@@@foo] From 169d3e40f23aa1ecc6ce780a506d40f9e96807c5 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 5 Jul 2023 14:53:07 +0200 Subject: [PATCH 18/26] Restore tests lost after merge --- .../tests/let_binding-in_indent.ml.ref | 240 +++++++++++++++++- test/passing/tests/let_binding-indent.ml.ref | 240 +++++++++++++++++- test/passing/tests/let_binding.ml | 230 +++++++++++++++++ test/passing/tests/let_binding.ml.ref | 240 +++++++++++++++++- test/passing/tests/wrapping_functor_args.ml | 29 +++ .../tests/wrapping_functor_args.ml.err | 1 + 6 files changed, 977 insertions(+), 3 deletions(-) diff --git a/test/passing/tests/let_binding-in_indent.ml.ref b/test/passing/tests/let_binding-in_indent.ml.ref index 8d594caeaa..9d8a1b5bd6 100644 --- a/test/passing/tests/let_binding-in_indent.ml.ref +++ b/test/passing/tests/let_binding-in_indent.ml.ref @@ -1,4 +1,242 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 + +let (x : int) = x2 + +let (_ : int) = x3 + +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + () + +let%ext (_ : int) = x1 + +let%ext (x : int) = x2 + +let%ext (_ : int) = x3 + +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 + +let [%ext: [%exp let x = 3]] = 2 + +let f : 'a. 'a ty -> 'a = fun y -> g y + +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () + +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] + +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in + fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo + +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in + fooooooooooooooooooooo + +let a : int = 0 + +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) ) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) + | b -> c ) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d ) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) -(** doc y *) and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end diff --git a/test/passing/tests/let_binding-indent.ml.ref b/test/passing/tests/let_binding-indent.ml.ref index 8d594caeaa..577469e2ae 100644 --- a/test/passing/tests/let_binding-indent.ml.ref +++ b/test/passing/tests/let_binding-indent.ml.ref @@ -1,4 +1,242 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 + +let (x : int) = x2 + +let (_ : int) = x3 + +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + () + +let%ext (_ : int) = x1 + +let%ext (x : int) = x2 + +let%ext (_ : int) = x3 + +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 + +let [%ext: [%exp let x = 3]] = 2 + +let f : 'a. 'a ty -> 'a = fun y -> g y + +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () + +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] + +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo + +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 + +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) ) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) + | b -> c ) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d ) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) -(** doc y *) and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end diff --git a/test/passing/tests/let_binding.ml b/test/passing/tests/let_binding.ml index de9e5a7ab4..e21a79764f 100644 --- a/test/passing/tests/let_binding.ml +++ b/test/passing/tests/let_binding.ml @@ -1,3 +1,233 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 + +let (x : int) = x2 + +let (_ : int) = x3 + +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + () + +let%ext (_ : int) = x1 + +let%ext (x : int) = x2 + +let%ext (_ : int) = x3 + +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 + +let [%ext: [%exp let x = 3]] = 2 + +let f : 'a. 'a ty -> 'a = fun y -> g y + +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () + +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb + cccccccccccccccccccccccc dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let _ : int = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext _ : int = x in + () + +let fooo = fooooooooooo [@@foo];; + +let fooo = fooooooooooo [@@foo] +and fooo = fooooooooooo [@@foo];; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let [@foo] fooo = fooooooooooo;; + +let [@foo] fooo = fooooooooooo +and [@foo] fooo = fooooooooooo;; + +let [@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 + +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b + and+ c = d in + e + +let _ = + if true then a + else let+ a = b in c + +let _ = + if true then let+ a = b in c + else d + +let _ = + match a with + | a -> + match a with + | a -> let+ a = b in match a with a -> a + +let _ = + match a with + | a -> + match a with + | a -> (let+ a = b in match a with a -> a) + | b -> c + +let _ = + let+ a b = c in + d + + +let _ = f (let+ a b = c in d) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) + +and y = () + +let x = () +[@@foo] +(* after x *) +(** doc x *) + +let y = () +[@@foo] +(* after y *) +(** doc y *) + +let x = () +(* after x *) +(** doc x *) + and y = () +[@@foo] +(* after y *) (** doc y *) + + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end diff --git a/test/passing/tests/let_binding.ml.ref b/test/passing/tests/let_binding.ml.ref index 8d594caeaa..b45a996b9a 100644 --- a/test/passing/tests/let_binding.ml.ref +++ b/test/passing/tests/let_binding.ml.ref @@ -1,4 +1,242 @@ +(* Note that {[ let ident : typ = exp ]} is different from {[ let (ident : + typ) = exp ]}. The difference should be maintained *) + +let (_ : int) = x1 + +let (x : int) = x2 + +let (_ : int) = x3 + +let x : int = x4 + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + () + +let%ext (_ : int) = x1 + +let%ext (x : int) = x2 + +let%ext (_ : int) = x3 + +let%ext x : int = x4 + +let%ext _ = + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let [%ext let x = 3] = 2 + +let [%ext: [%exp let x = 3]] = 2 + +let f : 'a. 'a ty -> 'a = fun y -> g y + +let f (A _ | B | C) = () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa _ | BBBBBBBBBBBBBBBBBBBBBbb + | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f + ( AAAAAAAAAAAAAAAAAAAAAAAAAAAAa + ( EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEe | FFFFFFFFFFFFFFFFFFFFFFFFFFf + | GGGGGGGGGGGGGGGGGGGGGGGGGGGGGGggggggggg ) + | BBBBBBBBBBBBBBBBBBBBBbb | CCCCCCCCCCCCCCCCCCCCCCccccc ) = + () + +let f (AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC) = () + +let f = function AAA (EEEEEEE | FFFFF | GGGGG) | BBBBBB | CCCCCCC -> () + +let f = function EEEEEEE | F | GGGGG | B | CCCCCCC -> () + +let f = function + | EEEEEEE | FFFFFFFFFFFFFFFFFFFFFFF | GGGGG + |BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBbb | CCCCCCC -> + () + +let (_ : t -> t -> int) = (compare : int list -> int list -> int) + +let _ = + let[@test] rec f = x in + y + +module Let_and_compact = struct + [@@@ocamlformat "let-and=compact"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 and y = 2 in + 3 + + let _ = + let%ext x = 2 and y = 2 in + 3 +end + +module Let_and_sparse = struct + [@@@ocamlformat "let-and=sparse"] + + let x = 2 + + and y = 2 + + let _ = + let x = 2 + and y = 2 in + 3 + + let _ = + let%ext x = 2 + and y = 2 in + 3 +end + +let f aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee = + () + +let _ = + fun aaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbbbbbb cccccccccccccccccccccccc + dddddddddddddddddd eeeeeeeeeeeeee -> + () + +let _ = + let (x : int) = x in + let x : int = x in + let (_ : int) = x in + let (_ : int) = x in + let%ext (x : int) = x in + let%ext x : int = x in + let%ext (_ : int) = x in + let%ext (_ : int) = x in + () + +let fooo = fooooooooooo [@@foo] + +let fooo = fooooooooooo [@@foo] + +and fooo = fooooooooooo [@@foo] +;; + +let foooo = fooooooooo [@@foo] in +fooooooooooooooooooooo + +let[@foo] fooo = fooooooooooo + +let[@foo] fooo = fooooooooooo + +and[@foo] fooo = fooooooooooo +;; + +let[@foo] foooo = fooooooooo in +fooooooooooooooooooooo + +let a : int = 0 + +let b = (0 : int) + +let _ = + let+ a = b in + c + +let _ = + let+ a = b and+ c = d in + e + +let _ = + if true then a + else + let+ a = b in + c + +let _ = + if true then + let+ a = b in + c + else d + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) ) + +let _ = + match a with + | a -> ( + match a with + | a -> ( + let+ a = b in + match a with a -> a ) + | b -> c ) + +let _ = + let+ a b = c in + d + +let _ = + f + (let+ a b = c in + d ) + +let () = + let* x = 1 (* blah *) and* y = 2 in + () + let x = () +(* after x *) + +let y = () + +let x = () +(* after x *) -(** doc y *) and y = () + +(** doc x *) +let x = () [@@foo] +(* after x *) + +(** doc y *) +let y = () [@@foo] +(* after y *) + +(** doc x *) +let x = () +(* after x *) + +(** doc y *) +and y = () [@@foo] +(* after y *) + +let _ = + let* () = + (* xxx *) + xxx + and* () = + (* yyy *) + yyy + in + zzz + +[@@@ocamlformat "let-binding-spacing=double-semicolon"] + +module A = struct + let f : int S.t ab -> float S.t ab -> string = + fun (l : int S.t ab) (r : float S.t ab) -> + match (l, r) with A, B -> "f A B" + ;; +end diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 7a4e1b516e..1ebfe6fd3e 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -1,3 +1,32 @@ +(* This declaration looks odd *) +type request_token = + Sociaml_oauth_client.Client.Make(Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + .request_token + +(* Whereas this one works well *) +module OauthClient = + Sociaml_oauth_client.Client.Make + (Sociaml_oauth_client.Posix.Clock) + (Sociaml_oauth_client.Posix.MAC_SHA1) + (Sociaml_oauth_client.Posix.Random) + +module F1 + (G : functor (_ : T) -> T) + (A : sig + val x : int + end) = +struct end + +module F2 + (G : functor (_ : T) -> + T_________________________________________________________________________) + (A : sig + val x : int + end) = +struct end + module F3 (G : functor (_ : T____________________________________________) diff --git a/test/passing/tests/wrapping_functor_args.ml.err b/test/passing/tests/wrapping_functor_args.ml.err index e69de29bb2..a42c68e69d 100644 --- a/test/passing/tests/wrapping_functor_args.ml.err +++ b/test/passing/tests/wrapping_functor_args.ml.err @@ -0,0 +1 @@ +Warning: tests/wrapping_functor_args.ml:23 exceeds the margin From 1404164181bd309f795e5f14c36969cc2a507193 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Wed, 5 Jul 2023 15:06:10 +0200 Subject: [PATCH 19/26] Restore docking of module type of struct --- lib/Fmt_ast.ml | 7 +++++-- lib/Params.ml | 3 +++ lib/Params.mli | 3 +++ test/passing/tests/js_source.ml.err | 10 +++++----- test/passing/tests/js_source.ml.ocp | 3 +-- test/passing/tests/js_source.ml.ref | 7 +++---- test/passing/tests/module_type.ml | 8 ++++---- test/passing/tests/source.ml.err | 2 +- test/passing/tests/source.ml.ref | 7 +++---- 9 files changed, 28 insertions(+), 22 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index a91bf4e6df..541e821e70 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3476,9 +3476,12 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t ( fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs $ epi ~attr:false (* Handled by [Sugar.mod_with]. *) ) | Pmty_typeof me -> - let pro = pro $ fmt "module type of@ " in + let break = + if Params.Mty.dock_typeof c.conf ~rhs:me then str " " else break 1 2 + in + let pro = pro $ fmt "module type of" $ break in let me_blk = fmt_module_expr c (sub_mod ~ctx me) in - hvbox_if box 2 (compose_module ~pro me_blk ~f:Fn.id $ epi ~attr:true) + hvbox_if box 0 (compose_module ~pro me_blk ~f:Fn.id $ epi ~attr:true) | Pmty_extension ext -> pro $ fmt_extension c ctx ext $ epi ~attr:true | Pmty_alias lid -> pro $ fmt_longident_loc c lid $ epi ~attr:true diff --git a/lib/Params.ml b/lib/Params.ml index ae42914550..e987572ff7 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -110,6 +110,9 @@ module Mty = struct match rhs.pmty_desc with | Pmty_signature _ | Pmty_with _ -> true | _ -> false + + let dock_typeof _c ~rhs = + match rhs.pmod_desc with Pmod_structure _ -> true | _ -> false end let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t) diff --git a/lib/Params.mli b/lib/Params.mli index 4fac96f850..8e660f7210 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -52,6 +52,9 @@ module Mty : sig val dock_functor_rhs : Conf.t -> rhs:module_type -> bool (** Whether functor types should be docked on the same line or break after the [->]. *) + + val dock_typeof : Conf.t -> rhs:module_expr -> bool + (** Whether to dock the RHS of a [module type of]. *) end val get_or_pattern_sep : diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 888dd309c6..92b4c79169 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ Warning: tests/js_source.ml:3556 exceeds the margin -Warning: tests/js_source.ml:9522 exceeds the margin -Warning: tests/js_source.ml:9625 exceeds the margin -Warning: tests/js_source.ml:9644 exceeds the margin -Warning: tests/js_source.ml:9684 exceeds the margin -Warning: tests/js_source.ml:9766 exceeds the margin +Warning: tests/js_source.ml:9521 exceeds the margin +Warning: tests/js_source.ml:9624 exceeds the margin +Warning: tests/js_source.ml:9643 exceeds the margin +Warning: tests/js_source.ml:9683 exceeds the margin +Warning: tests/js_source.ml:9765 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 2b202fa8e5..68f97dee86 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -4995,8 +4995,7 @@ module Foo (Bar : sig type a = private [> `A ] end) - (Baz : module type of - struct + (Baz : module type of struct include Bar end) = struct end diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 71a9fe5990..cb0b43aa67 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -4995,10 +4995,9 @@ module Foo (Bar : sig type a = private [> `A ] end) - (Baz : module type of - struct - include Bar - end) = + (Baz : module type of struct + include Bar + end) = struct end module Bazoinks = struct diff --git a/test/passing/tests/module_type.ml b/test/passing/tests/module_type.ml index c3daede2e2..897f8c7373 100644 --- a/test/passing/tests/module_type.ml +++ b/test/passing/tests/module_type.ml @@ -74,13 +74,13 @@ module M : sig include (* foo *) module type of K include module type of - Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) - (Fooooooooooooo) + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) include (* fooooooooo *) module type of - Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) - (Fooooooooooooo) + Fooooooooooooooooooooooooooo (Foooooooooo.Foo) (Fooooooooooooo) + (Fooooooooooooo) end = struct end let foo (type foooo fooo_ooooo) diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 8b168c8703..83f38b23b4 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,3 +1,3 @@ Warning: tests/source.ml:697 exceeds the margin Warning: tests/source.ml:2313 exceeds the margin -Warning: tests/source.ml:8022 exceeds the margin +Warning: tests/source.ml:8021 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 3bdfaff335..610a059e89 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -4747,10 +4747,9 @@ let _ = f (module A_alias) (* doesn't type either *) module Foo (Bar : sig type a = private [> `A] -end) (Baz : module type of - struct - include Bar - end) = +end) (Baz : module type of struct + include Bar +end) = struct end module Bazoinks = struct From b803db2128c85941d8e61dfb36f53a9fc40f7391 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 16:57:39 +0200 Subject: [PATCH 20/26] Restore formatting of 'sig ... end with ...' --- lib/Fmt_ast.ml | 2 +- lib/Params.ml | 5 +++++ lib/Params.mli | 3 +++ test/passing/tests/js_source.ml.err | 10 +++++----- test/passing/tests/js_source.ml.ocp | 6 ++++-- test/passing/tests/js_source.ml.ref | 6 ++++-- test/passing/tests/module.ml | 9 ++++++--- test/passing/tests/source.ml.ref | 6 ++++-- 8 files changed, 32 insertions(+), 15 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 541e821e70..156cc6fc72 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3472,7 +3472,7 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t ( list_fl wcs_and fmt_cstr $ fmt_attributes c ~pre:(Break (1, -1)) attr ) ) in - hovbox_if box 2 + Params.Mty.box_with c.conf ~box ~lhs:mt.ast ( fmt_module_type c ~pro mt $ list_fl wcs fmt_cstrs $ epi ~attr:false (* Handled by [Sugar.mod_with]. *) ) | Pmty_typeof me -> diff --git a/lib/Params.ml b/lib/Params.ml index e987572ff7..f338318fc1 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -113,6 +113,11 @@ module Mty = struct let dock_typeof _c ~rhs = match rhs.pmod_desc with Pmod_structure _ -> true | _ -> false + + let box_with _c ~box ~lhs = + match lhs.pmty_desc with + | Pmty_signature _ -> hvbox_if box 0 + | _ -> hovbox_if box 2 end let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t) diff --git a/lib/Params.mli b/lib/Params.mli index 8e660f7210..21d5b7787b 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -55,6 +55,9 @@ module Mty : sig val dock_typeof : Conf.t -> rhs:module_expr -> bool (** Whether to dock the RHS of a [module type of]. *) + + val box_with : Conf.t -> box:bool -> lhs:module_type -> Fmt.t -> Fmt.t + (** The box around a [Pmty_with]. *) end val get_or_pattern_sep : diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index 92b4c79169..c46ab5f3ee 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ Warning: tests/js_source.ml:3556 exceeds the margin -Warning: tests/js_source.ml:9521 exceeds the margin -Warning: tests/js_source.ml:9624 exceeds the margin -Warning: tests/js_source.ml:9643 exceeds the margin -Warning: tests/js_source.ml:9683 exceeds the margin -Warning: tests/js_source.ml:9765 exceeds the margin +Warning: tests/js_source.ml:9523 exceeds the margin +Warning: tests/js_source.ml:9626 exceeds the margin +Warning: tests/js_source.ml:9645 exceeds the margin +Warning: tests/js_source.ml:9685 exceeds the margin +Warning: tests/js_source.ml:9767 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 68f97dee86..93d3141518 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -8300,7 +8300,8 @@ module type S = sig module M : sig type t end -end with module M = M +end +with module M = M module type Printable = sig type t @@ -8374,7 +8375,8 @@ module type S' = S with module T := M module type S = sig type 'a t -end with type 'a t := unit +end +with type 'a t := unit (* Fails *) let property (type t) () = diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index cb0b43aa67..c5d8639d1e 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -8300,7 +8300,8 @@ module type S = sig module M : sig type t end -end with module M = M +end +with module M = M module type Printable = sig type t @@ -8374,7 +8375,8 @@ module type S' = S with module T := M module type S = sig type 'a t -end with type 'a t := unit +end +with type 'a t := unit (* Fails *) let property (type t) () = diff --git a/test/passing/tests/module.ml b/test/passing/tests/module.ml index 30d31ef6f5..ecb3bd2f47 100644 --- a/test/passing/tests/module.ml +++ b/test/passing/tests/module.ml @@ -31,13 +31,15 @@ end module O : sig type t -end with type t := t = struct +end +with type t := t = struct let () = () end module O : sig type t -end with type t := t and type s := s = struct +end +with type t := t and type s := s = struct let () = () end @@ -55,7 +57,8 @@ let x = (module struct end : S) module rec A : sig type t -end with type t = int = struct +end +with type t = int = struct type t = int end diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 610a059e89..8bc4a632f8 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -8047,7 +8047,8 @@ module type S = sig module M : sig type t end -end with module M = M +end +with module M = M module type Printable = sig type t @@ -8126,7 +8127,8 @@ module type S' = S with module T := M module type S = sig type 'a t -end with type 'a t := unit +end +with type 'a t := unit (* Fails *) let property (type t) () = From 9d72f4c359ec3cb2d0f3e46b8f14805ab29d174f Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 17:22:13 +0200 Subject: [PATCH 21/26] Fix indentation of sig of modules with args --- lib/Fmt_ast.ml | 16 ++++++---------- lib/Params.ml | 9 ++++----- test/passing/tests/doc_comments-after.ml.ref | 2 +- .../tests/doc_comments-before-except-val.ml.ref | 2 +- test/passing/tests/doc_comments-before.ml.ref | 2 +- test/passing/tests/doc_comments.ml.ref | 2 +- test/passing/tests/let_module-sparse.ml.ref | 2 +- test/passing/tests/let_module.ml.ref | 2 +- test/passing/tests/source.ml.ref | 4 ++-- 9 files changed, 18 insertions(+), 23 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 156cc6fc72..798fd217aa 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3676,30 +3676,26 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") fmt_docstring_around_item c ~force_before:(not single_line) ~fit:true attributes in - let fmt_mty = + let fmt_mty ~epi = let args ~epi = - hvbox args_p.indent + hvbox ~name:"args" args_p.indent ( ( if args_p.dock then fmt_args_docked ~pro:intro xargs else intro $ fmt_args_wrapped xargs ) $ epi ) in + let epi = fmt_if (Option.is_some xbody) " =" $ epi in match xmty with | Some xmty -> let break = if args_p.dock then str " " else fmt "@ " in let pro = args ~epi:(str " " $ str eqty $ break) in - fmt_module_type ~pro c xmty - | None -> args ~epi:noop + hovbox 0 (fmt_module_type ~pro c xmty $ epi) + | None -> hvbox 0 (args ~epi:noop $ epi) in hvbox (if compact then 0 else 2) ( doc_before $ blk_box blk_b - (* Avod break after [=] if there was a module type. *) - ( (if Option.is_some xmty then hovbox else hvbox) - 0 - ( fmt_mty - $ fmt_if (Option.is_some xbody) " =" - $ fmt_if_k compact fmt_pro ) + ( fmt_mty ~epi:(fmt_if_k compact fmt_pro) $ fmt_if_k (not compact) fmt_pro $ blk_b.psp $ fmt_if (Option.is_none blk_b.pro && Option.is_some xbody) "@ " diff --git a/lib/Params.ml b/lib/Params.ml index f338318fc1..2e4a432549 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -93,16 +93,15 @@ module Mod = struct | _ -> false let get_args (c : Conf.t) args = - let indent, psp_indent = if ocp c then (2, 2) else (0, 4) in let dock = (* ocp-indent-compat: Dock only one argument to avoid alignment of subsequent arguments. *) if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false else List.for_all ~f:arg_is_sig args in - let arg_psp = if dock then str " " else break 1 psp_indent in + let arg_psp = if dock then str " " else break 1 2 in let align = ocp c in - {dock; arg_psp; indent; align} + {dock; arg_psp; indent= 2; align} end module Mty = struct @@ -116,8 +115,8 @@ module Mty = struct let box_with _c ~box ~lhs = match lhs.pmty_desc with - | Pmty_signature _ -> hvbox_if box 0 - | _ -> hovbox_if box 2 + | Pmty_signature _ -> hvbox_if ~name:"with" box 0 + | _ -> hovbox_if ~name:"with" box 2 end let get_or_pattern_sep ?(cmts_before = false) ?(space = false) (c : Conf.t) diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index b44401e250..96c31797d2 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -125,7 +125,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) : - sig end + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index 683b75afe2..f818a22774 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -125,7 +125,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) : - sig end + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index 77b6656629..f32eda352a 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -125,7 +125,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) : - sig end + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index 683b75afe2..f818a22774 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -125,7 +125,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) : - sig end + sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/let_module-sparse.ml.ref b/test/passing/tests/let_module-sparse.ml.ref index 66a42f904a..4dae3fecc9 100644 --- a/test/passing/tests/let_module-sparse.ml.ref +++ b/test/passing/tests/let_module-sparse.ml.ref @@ -57,5 +57,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/let_module.ml.ref b/test/passing/tests/let_module.ml.ref index e484db2ded..3d7ad2f82c 100644 --- a/test/passing/tests/let_module.ml.ref +++ b/test/passing/tests/let_module.ml.ref @@ -49,5 +49,5 @@ let () = let f () = let module (* comment *) - M = struct end in + M = struct end in () diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 8bc4a632f8..626cfa44b6 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -6913,7 +6913,7 @@ type 'a tree = E | N of 'a tree * 'a * 'a tree module Bootstrap2 (MakeDiet : functor (X : ORD) -> SET with type t = X.t tree and type elt = X.t) : -SET with type elt = int = struct + SET with type elt = int = struct type elt = int module rec Elt : sig @@ -7337,7 +7337,7 @@ end module Bootstrap (MakeH : functor (Element : ORDERED) -> HEAP with module Elem = Element) (Element : ORDERED) : -HEAP with module Elem = Element = struct + HEAP with module Elem = Element = struct module Elem = Element module rec BE : sig From b7f734f9a5c184bc5331e1745ef8ed7b9812c4d5 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 17:34:13 +0200 Subject: [PATCH 22/26] Dock sig after module arguments In the case where arguments are docked too, also dock `Pmty_ident` and some forms of `Pmty_with` to avoid lines with just `end`. --- lib/Fmt_ast.ml | 8 +++++++- lib/Params.ml | 8 ++++++++ lib/Params.mli | 5 +++++ test/passing/tests/doc_comments-after.ml.err | 2 +- test/passing/tests/doc_comments-after.ml.ref | 3 +-- test/passing/tests/doc_comments-before-except-val.ml.err | 2 +- test/passing/tests/doc_comments-before-except-val.ml.ref | 3 +-- test/passing/tests/doc_comments-before.ml.err | 2 +- test/passing/tests/doc_comments-before.ml.ref | 3 +-- test/passing/tests/doc_comments.ml.err | 2 +- test/passing/tests/doc_comments.ml.ref | 3 +-- 11 files changed, 28 insertions(+), 13 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 798fd217aa..4663143122 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3686,7 +3686,13 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") let epi = fmt_if (Option.is_some xbody) " =" $ epi in match xmty with | Some xmty -> - let break = if args_p.dock then str " " else fmt "@ " in + let break = + if + Params.Mty.dock_module_sig c.conf ~args_are_docked:args_p.dock + xmty.ast + then str " " + else fmt "@ " + in let pro = args ~epi:(str " " $ str eqty $ break) in hovbox 0 (fmt_module_type ~pro c xmty $ epi) | None -> hvbox 0 (args ~epi:noop $ epi) diff --git a/lib/Params.ml b/lib/Params.ml index 2e4a432549..6c2ab977ab 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -110,6 +110,14 @@ module Mty = struct | Pmty_signature _ | Pmty_with _ -> true | _ -> false + let dock_module_sig (_c : Conf.t) ~args_are_docked mty = + match mty.pmty_desc with + | Pmty_signature _ -> true + | Pmty_ident _ + |Pmty_with ({pmty_desc= Pmty_signature _ | Pmty_ident _; _}, _) -> + args_are_docked + | _ -> false + let dock_typeof _c ~rhs = match rhs.pmod_desc with Pmod_structure _ -> true | _ -> false diff --git a/lib/Params.mli b/lib/Params.mli index 21d5b7787b..59f3476cb3 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -53,6 +53,11 @@ module Mty : sig (** Whether functor types should be docked on the same line or break after the [->]. *) + val dock_module_sig : Conf.t -> args_are_docked:bool -> module_type -> bool + (** Whether the signature of a module decl should be docked after the [:]. + [~args_are_docked] expects the [dock] field returned by + {!Mod.get_args}. *) + val dock_typeof : Conf.t -> rhs:module_expr -> bool (** Whether to dock the RHS of a [module type of]. *) diff --git a/test/passing/tests/doc_comments-after.ml.err b/test/passing/tests/doc_comments-after.ml.err index 50431af122..dd738d90f3 100644 --- a/test/passing/tests/doc_comments-after.ml.err +++ b/test/passing/tests/doc_comments-after.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:302 exceeds the margin +Warning: tests/doc_comments.ml:301 exceeds the margin diff --git a/test/passing/tests/doc_comments-after.ml.ref b/test/passing/tests/doc_comments-after.ml.ref index 96c31797d2..fdacc13e71 100644 --- a/test/passing/tests/doc_comments-after.ml.ref +++ b/test/passing/tests/doc_comments-after.ml.ref @@ -124,8 +124,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : - sig end + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before-except-val.ml.err b/test/passing/tests/doc_comments-before-except-val.ml.err index 50431af122..dd738d90f3 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.err +++ b/test/passing/tests/doc_comments-before-except-val.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:302 exceeds the margin +Warning: tests/doc_comments.ml:301 exceeds the margin diff --git a/test/passing/tests/doc_comments-before-except-val.ml.ref b/test/passing/tests/doc_comments-before-except-val.ml.ref index f818a22774..59a6180c19 100644 --- a/test/passing/tests/doc_comments-before-except-val.ml.ref +++ b/test/passing/tests/doc_comments-before-except-val.ml.ref @@ -124,8 +124,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : - sig end + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments-before.ml.err b/test/passing/tests/doc_comments-before.ml.err index 50431af122..dd738d90f3 100644 --- a/test/passing/tests/doc_comments-before.ml.err +++ b/test/passing/tests/doc_comments-before.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:302 exceeds the margin +Warning: tests/doc_comments.ml:301 exceeds the margin diff --git a/test/passing/tests/doc_comments-before.ml.ref b/test/passing/tests/doc_comments-before.ml.ref index f32eda352a..efa518581f 100644 --- a/test/passing/tests/doc_comments-before.ml.ref +++ b/test/passing/tests/doc_comments-before.ml.ref @@ -124,8 +124,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : - sig end + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig diff --git a/test/passing/tests/doc_comments.ml.err b/test/passing/tests/doc_comments.ml.err index 50431af122..dd738d90f3 100644 --- a/test/passing/tests/doc_comments.ml.err +++ b/test/passing/tests/doc_comments.ml.err @@ -1 +1 @@ -Warning: tests/doc_comments.ml:302 exceeds the margin +Warning: tests/doc_comments.ml:301 exceeds the margin diff --git a/test/passing/tests/doc_comments.ml.ref b/test/passing/tests/doc_comments.ml.ref index f818a22774..59a6180c19 100644 --- a/test/passing/tests/doc_comments.ml.ref +++ b/test/passing/tests/doc_comments.ml.ref @@ -124,8 +124,7 @@ module Comment_placement : sig (Foo : BAR) (Foo : BAR) (Foo : BAR) - (Foo : BAR) : - sig end + (Foo : BAR) : sig end (** Doc comment still goes after *) module Make (Config : sig From 0fa1dacd17f56bfa9915f6cc253c91cc7d916f0f Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 17:44:36 +0200 Subject: [PATCH 23/26] Update CHANGES --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index cea9fd48c2..5edc585066 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,7 +13,6 @@ - Protect match after `fun _ : _ ->` (#2352, @Julow) - Fix invalid formatting of `(::)` (#2347, @Julow) - Fix formatting of string literals in code blocks (#2338, #2349, @Julow) -- Improve formatting of module arguments (#2322, @Julow) - Consistent indentation of `@@ let+ x = ...` (#2315, @Julow) - Remove double parenthesis around tuple in a match (#2308, @Julow) - Consistent indentation of `fun (type a) ->` that follow `fun x ->` (#2294, @Julow) @@ -27,6 +26,7 @@ ### Changes +- More consistent formatting of module types (#2322, #2395, @Julow) - Improve formatting of doc-comments (#2376, #2377, #2379, #2378, @Julow) - Disable reporting of deprecated alerts while formatting code blocks (#2373, @Julow) - Improve indentation of `as`-patterns (#2359, @Julow) From 30dd49c5b30269d9debdd4696636bea9cccab846 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 18:21:27 +0200 Subject: [PATCH 24/26] Consistency between module args and functor exprs --- lib/Fmt_ast.ml | 105 ++++++++---------- test/passing/tests/apply_functor.ml | 4 +- test/passing/tests/functor.ml | 9 +- test/passing/tests/js_source.ml.err | 12 +- test/passing/tests/js_source.ml.ocp | 14 +-- test/passing/tests/js_source.ml.ref | 8 +- test/passing/tests/module_type.ml | 11 +- test/passing/tests/module_type.ml.err | 1 + .../open-closing-on-separate-line.ml.ref | 24 +--- test/passing/tests/open.ml.ref | 24 +--- test/passing/tests/source.ml.err | 2 +- test/passing/tests/source.ml.ref | 8 +- test/passing/tests/wrapping_functor_args.ml | 4 +- 13 files changed, 91 insertions(+), 135 deletions(-) create mode 100644 test/passing/tests/module_type.ml.err diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 4663143122..479d77a6bf 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3396,16 +3396,41 @@ and fmt_extension_constructor c ctx ec = | Pext_rebind lid -> str " = " $ fmt_longident_loc c lid ) $ fmt_attributes_and_docstrings c pext_attributes ) -and fmt_functor_param c ctx {loc; txt= arg} = - match arg with - | Unit -> Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) - | Named (name, mt) -> - let xmt = sub_mty ~ctx mt in - Cmts.fmt c loc - (wrap "(" ")" - (hovbox 0 - ( hovbox 0 (fmt_str_loc_opt c name $ fmt "@ : ") - $ fmt_module_type c xmt ) ) ) +and fmt_functor_params c ~ctx ?(pro = noop) ?(epi = noop) args = + let args_p = Params.Mod.get_args c.conf args in + let box_arg = + let indent = if args_p.align then 1 else 0 in + hvbox_if ((not args_p.dock) && args_p.align) indent + in + let fmt_name_and_mt ~pro ~loc name mt = + let pro = pro $ Cmts.fmt_before c loc $ str "(" in + let pro_inner, pro_outer = + if args_p.dock then (pro, noop) else (noop, pro) + in + let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " + and epi = str ")" in + pro_outer + $ box_arg (fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt)) + $ Cmts.fmt_after c loc + in + let fmt_arg ~pro {loc; txt= arg} = + let pro = pro $ args_p.arg_psp in + match arg with + | Unit -> pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) + | Named (name, mt) -> fmt_name_and_mt ~pro ~loc name mt + in + let rec fmt_args_docked ~pro = function + | [] -> pro + | hd :: tl -> fmt_args_docked ~pro:(fmt_arg ~pro hd) tl + in + let rec fmt_args_wrapped = function + | [] -> noop + | hd :: tl -> fmt_arg ~pro:noop hd $ fmt_args_wrapped tl + in + hvbox ~name:"args" args_p.indent + ( ( if args_p.dock then fmt_args_docked ~pro args + else pro $ fmt_args_wrapped args ) + $ epi ) and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t = @@ -3438,19 +3463,17 @@ and fmt_module_type c ?(box = true) ?pro ?epi ({ast= mty; _} as xmty) : Fmt.t $ fmt_attributes_and_docstrings c pmty_attributes $ epi ~attr:false ) ) | Pmty_functor (args, mt) -> - let intro = - hvbox 2 - ( pro $ str "functor" - $ fmt_attributes c ~pre:Blank pmty_attributes - $ fmt "@ " - $ list args "@ " (fmt_functor_param c ctx) - $ fmt " ->" ) + let fmt_args = + let pro = + pro $ str "functor" $ fmt_attributes c ~pre:Blank pmty_attributes + and epi = str " ->" in + fmt_functor_params c ~ctx ~pro ~epi args and epi = epi ~attr:false in if Params.Mty.dock_functor_rhs c.conf ~rhs:mt then - let pro = intro $ str " " in + let pro = fmt_args $ str " " in fmt_module_type c ~box ~pro ~epi (sub_mty ~ctx mt) else - let pro = intro $ fmt "@ " in + let pro = fmt_args $ fmt "@ " in hovbox_if box 2 (pro $ fmt_module_type c (sub_mty ~ctx mt) $ epi) | Pmty_gen (gen_loc, mt) -> let pro = @@ -3631,33 +3654,6 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") name xargs xbody xmty attributes ~rec_flag = let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in let args_p = Params.Mod.get_args c.conf xargs in - let fmt_name_and_mt ~pro ~docked ~loc name mt = - let pro = pro $ Cmts.fmt_before c loc $ str "(" in - let pro_inner, pro_outer = if docked then (pro, noop) else (noop, pro) in - let intro = pro_inner $ fmt_str_loc_opt c name $ str " : " - and epi = str ")" in - let bdy_indent = if args_p.align then 1 else 0 in - pro_outer - $ hvbox_if - ((not docked) && args_p.align) - bdy_indent - (fmt_module_type ~pro:intro ~epi c (sub_mty ~ctx mt)) - $ Cmts.fmt_after c loc - in - let fmt_arg ~pro ~docked {loc; txt} = - let pro = pro $ args_p.arg_psp in - match txt with - | Unit -> pro $ Cmts.fmt c loc (wrap "(" ")" (Cmts.fmt_within c loc)) - | Named (name, mt) -> fmt_name_and_mt ~pro ~docked ~loc name mt - in - let rec fmt_args_docked ~pro = function - | [] -> pro - | hd :: tl -> fmt_args_docked ~pro:(fmt_arg ~pro ~docked:true hd) tl - in - let rec fmt_args_wrapped = function - | [] -> noop - | hd :: tl -> fmt_arg ~pro:noop ~docked:false hd $ fmt_args_wrapped tl - in let intro = str keyword $ fmt_extension_suffix c ext @@ -3677,12 +3673,7 @@ and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") attributes in let fmt_mty ~epi = - let args ~epi = - hvbox ~name:"args" args_p.indent - ( ( if args_p.dock then fmt_args_docked ~pro:intro xargs - else intro $ fmt_args_wrapped xargs ) - $ epi ) - in + let args ~epi = fmt_functor_params c ~ctx ~pro:intro ~epi xargs in let epi = fmt_if (Option.is_some xbody) " =" $ epi in match xmty with | Some xmty -> @@ -3945,17 +3936,17 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) = $ fmt_attributes_and_docstrings c pmod_attributes ) } | Pmod_functor (args, me) -> let doc, atrs = doc_atrs pmod_attributes in + let fmt_args = + let pro = str "functor" $ fmt_attributes c ~pre:Blank atrs in + fmt_functor_params c ~ctx ~pro args + in { empty with bdy= Cmts.fmt c pmod_loc ( fmt_docstring c ~epi:(fmt "@,") doc $ hvbox 0 (wrap_if parens "(" ")" - ( str "functor" - $ fmt_attributes c ~pre:Blank atrs - $ fmt "@;<1 2>" - $ list args "@;<1 2>" (fmt_functor_param c ctx) - $ fmt "@;<1 2>->@;<1 2>" + ( fmt_args $ fmt " ->@;<1 2>" $ compose_module (fmt_module_expr c (sub_mod ~ctx me)) ~f:(hvbox 0) ) ) ) } diff --git a/test/passing/tests/apply_functor.ml b/test/passing/tests/apply_functor.ml index 4850426595..809b6b881e 100644 --- a/test/passing/tests/apply_functor.ml +++ b/test/passing/tests/apply_functor.ml @@ -1,7 +1,5 @@ module _ = F (functor (X : T) -> X) module _ = F - (functor - (X____________________________ : T) - -> + (functor (X____________________________ : T) -> X____________________________) diff --git a/test/passing/tests/functor.ml b/test/passing/tests/functor.ml index 339fdfb32b..01568b90f6 100644 --- a/test/passing/tests/functor.ml +++ b/test/passing/tests/functor.ml @@ -13,8 +13,8 @@ module type M = functor (S : S) (T : T) -> U module type M = functor (S : S) () -> sig end module type M = functor - (SSSSS : SSSSSSSSSSSSSS) - (TTTTT : TTTTTTTTTTTTTTTT) -> sig + (SSSSS : SSSSSSSSSSSSSS) + (TTTTT : TTTTTTTTTTTTTTTT) -> sig val t1 : a val t2 : b @@ -39,10 +39,7 @@ module type S = sig end module M = - (functor - (SSSSS : sssssSSSSSSSSSSSSSS) - (TTTTT : TTTTTTTTTTTTTTTTTTTTT) - -> + (functor (SSSSS : sssssSSSSSSSSSSSSSS) (TTTTT : TTTTTTTTTTTTTTTTTTTTT) -> struct let x = 2 diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index c46ab5f3ee..d0283c0ee8 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ -Warning: tests/js_source.ml:3556 exceeds the margin -Warning: tests/js_source.ml:9523 exceeds the margin -Warning: tests/js_source.ml:9626 exceeds the margin -Warning: tests/js_source.ml:9645 exceeds the margin -Warning: tests/js_source.ml:9685 exceeds the margin -Warning: tests/js_source.ml:9767 exceeds the margin +Warning: tests/js_source.ml:3554 exceeds the margin +Warning: tests/js_source.ml:9521 exceeds the margin +Warning: tests/js_source.ml:9624 exceeds the margin +Warning: tests/js_source.ml:9643 exceeds the margin +Warning: tests/js_source.ml:9683 exceeds the margin +Warning: tests/js_source.ml:9765 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index 93d3141518..ab48b497cd 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -3020,14 +3020,12 @@ type (_, _) eq = Refl : ('a, 'a) eq let magic : 'a 'b. 'a -> 'b = fun (type a b) (x : a) -> let module M = - (functor - (T : sig - type 'a t - end) - -> - struct - let f (Refl : (a T.t, b T.t) eq) = (x :> b) - end) + (functor (T : sig + type 'a t + end) -> + struct + let f (Refl : (a T.t, b T.t) eq) = (x :> b) + end) (struct type 'a t = unit end) diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index c5d8639d1e..24626b7a48 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -3020,11 +3020,9 @@ type (_, _) eq = Refl : ('a, 'a) eq let magic : 'a 'b. 'a -> 'b = fun (type a b) (x : a) -> let module M = - (functor - (T : sig - type 'a t - end) - -> + (functor (T : sig + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) end) diff --git a/test/passing/tests/module_type.ml b/test/passing/tests/module_type.ml index 897f8c7373..e8f5344077 100644 --- a/test/passing/tests/module_type.ml +++ b/test/passing/tests/module_type.ml @@ -61,12 +61,11 @@ module type S = sig end module type S' = functor - (A : A) - (B : sig - type t - end) - (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - : sig + (A : A) + (B : sig + type t + end) + (Cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc : sig type t end) -> S with type t = B.t diff --git a/test/passing/tests/module_type.ml.err b/test/passing/tests/module_type.ml.err new file mode 100644 index 0000000000..adbc84ff18 --- /dev/null +++ b/test/passing/tests/module_type.ml.err @@ -0,0 +1 @@ +Warning: tests/module_type.ml:67 exceeds the margin diff --git a/test/passing/tests/open-closing-on-separate-line.ml.ref b/test/passing/tests/open-closing-on-separate-line.ml.ref index 4ccac15195..77604369f8 100644 --- a/test/passing/tests/open-closing-on-separate-line.ml.ref +++ b/test/passing/tests/open-closing-on-separate-line.ml.ref @@ -210,17 +210,13 @@ open struct end open - functor - (A : S) - -> + functor (A : S) -> struct type t end open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end @@ -240,16 +236,12 @@ let _ = type t end in let open - functor - (A : S) - -> + functor (A : S) -> struct type t end in let open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end in @@ -267,17 +259,13 @@ open struct end [@@attr] open - functor - (A : S) - -> + functor (A : S) -> struct type t end [@@attr] open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end [@@attr] diff --git a/test/passing/tests/open.ml.ref b/test/passing/tests/open.ml.ref index 26e0737169..32ee78ac4b 100644 --- a/test/passing/tests/open.ml.ref +++ b/test/passing/tests/open.ml.ref @@ -202,17 +202,13 @@ open struct end open - functor - (A : S) - -> + functor (A : S) -> struct type t end open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end @@ -232,16 +228,12 @@ let _ = type t end in let open - functor - (A : S) - -> + functor (A : S) -> struct type t end in let open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end in @@ -259,17 +251,13 @@ open struct end [@@attr] open - functor - (A : S) - -> + functor (A : S) -> struct type t end [@@attr] open - functor - (_ : S) - -> + functor (_ : S) -> struct type t end [@@attr] diff --git a/test/passing/tests/source.ml.err b/test/passing/tests/source.ml.err index 83f38b23b4..a1caa61d09 100644 --- a/test/passing/tests/source.ml.err +++ b/test/passing/tests/source.ml.err @@ -1,3 +1,3 @@ Warning: tests/source.ml:697 exceeds the margin Warning: tests/source.ml:2313 exceeds the margin -Warning: tests/source.ml:8021 exceeds the margin +Warning: tests/source.ml:8019 exceeds the margin diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 626cfa44b6..6f0b0647fb 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -2883,11 +2883,9 @@ type (_, _) eq = Refl : ('a, 'a) eq let magic : 'a 'b. 'a -> 'b = fun (type a b) (x : a) -> let module M = - (functor - (T : sig - type 'a t - end) - -> + (functor (T : sig + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) end) diff --git a/test/passing/tests/wrapping_functor_args.ml b/test/passing/tests/wrapping_functor_args.ml index 1ebfe6fd3e..62abde5ae7 100644 --- a/test/passing/tests/wrapping_functor_args.ml +++ b/test/passing/tests/wrapping_functor_args.ml @@ -29,8 +29,8 @@ struct end module F3 (G : functor - (_ : T____________________________________________) - (_ : T____________________________________________) -> T) + (_ : T____________________________________________) + (_ : T____________________________________________) -> T) (A : sig val x : int end) = From 11d7f162e1cb01ae3a8bb7aa380ef087eae5bbbb Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Thu, 6 Jul 2023 18:50:48 +0200 Subject: [PATCH 25/26] Indent Pmod_functor --- lib/Fmt_ast.ml | 8 +++++--- test/passing/tests/js_source.ml.ref | 2 +- test/passing/tests/source.ml.ref | 2 +- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 479d77a6bf..403fbe760e 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3941,12 +3941,14 @@ and fmt_module_expr ?(dock_struct = true) c ({ast= m; _} as xmod) = fmt_functor_params c ~ctx ~pro args in { empty with - bdy= + opn= Some (open_hvbox 2) + ; cls= close_box + ; bdy= Cmts.fmt c pmod_loc ( fmt_docstring c ~epi:(fmt "@,") doc - $ hvbox 0 + $ hvbox 2 (wrap_if parens "(" ")" - ( fmt_args $ fmt " ->@;<1 2>" + ( fmt_args $ fmt " ->@ " $ compose_module (fmt_module_expr c (sub_mod ~ctx me)) ~f:(hvbox 0) ) ) ) } diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index 24626b7a48..c4a9a91e43 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -6003,7 +6003,7 @@ module Y = functor (X : sig end) (Y : sig end) (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 + functor (X : sig end) () (Z : sig end) -> struct end module F (X : sig end) = struct type t = int diff --git a/test/passing/tests/source.ml.ref b/test/passing/tests/source.ml.ref index 6f0b0647fb..d28b0e632a 100644 --- a/test/passing/tests/source.ml.ref +++ b/test/passing/tests/source.ml.ref @@ -5765,7 +5765,7 @@ module Y = functor (X : sig end) (Y : sig end) (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 + functor (X : sig end) () (Z : sig end) -> struct end module F (X : sig end) = struct type t = int From 4f570c090f604b56477a5958c83a2d64ae1caa3a Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 18 Jul 2023 15:46:06 +0200 Subject: [PATCH 26/26] ocp-indent-compat: Don't dock Pmty_functor --- lib/Fmt_ast.ml | 4 ++-- lib/Params.ml | 10 +++++++--- lib/Params.mli | 3 ++- test/passing/tests/js_source.ml.err | 12 ++++++------ test/passing/tests/js_source.ml.ocp | 7 ++++--- test/passing/tests/js_source.ml.ref | 7 ++++--- 6 files changed, 25 insertions(+), 18 deletions(-) diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index 403fbe760e..30ec7d1380 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -3397,7 +3397,7 @@ and fmt_extension_constructor c ctx ec = $ fmt_attributes_and_docstrings c pext_attributes ) and fmt_functor_params c ~ctx ?(pro = noop) ?(epi = noop) args = - let args_p = Params.Mod.get_args c.conf args in + let args_p = Params.Mod.get_args c.conf ~ctx args in let box_arg = let indent = if args_p.align then 1 else 0 in hvbox_if ((not args_p.dock) && args_p.align) indent @@ -3653,7 +3653,7 @@ and fmt_class_exprs ?ext c ctx cls = and fmt_module c ctx ?ext ?epi ?(can_sparse = false) keyword ?(eqty = "=") name xargs xbody xmty attributes ~rec_flag = let blk_b = Option.value_map xbody ~default:empty ~f:(fmt_module_expr c) in - let args_p = Params.Mod.get_args c.conf xargs in + let args_p = Params.Mod.get_args c.conf ~ctx xargs in let intro = str keyword $ fmt_extension_suffix c ext diff --git a/lib/Params.ml b/lib/Params.ml index 6c2ab977ab..525d0fdf62 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -92,11 +92,15 @@ module Mod = struct true | _ -> false - let get_args (c : Conf.t) args = + let get_args (c : Conf.t) ~ctx args = let dock = (* ocp-indent-compat: Dock only one argument to avoid alignment of - subsequent arguments. *) - if ocp c then match args with [arg] -> arg_is_sig arg | _ -> false + subsequent arguments. Avoid docking for module exprs and module type + exprs to also avoid alignment. *) + if ocp c then + match ctx, args with + | Ast.Mb _, [arg] -> arg_is_sig arg + | _ -> false else List.for_all ~f:arg_is_sig args in let arg_psp = if dock then str " " else break 1 2 in diff --git a/lib/Params.mli b/lib/Params.mli index 59f3476cb3..04b96e68c8 100644 --- a/lib/Params.mli +++ b/lib/Params.mli @@ -45,7 +45,8 @@ module Mod : sig ; align: bool (** Whether to align argument types inside their parenthesis. *) } - val get_args : Conf.t -> functor_parameter loc list -> args + (** Can be called from [Pmty_functor], [Pmod_functor] or [Pstr_module]. *) + val get_args : Conf.t -> ctx:Ast.t -> functor_parameter loc list -> args end module Mty : sig diff --git a/test/passing/tests/js_source.ml.err b/test/passing/tests/js_source.ml.err index d0283c0ee8..f0ca9abf10 100644 --- a/test/passing/tests/js_source.ml.err +++ b/test/passing/tests/js_source.ml.err @@ -1,6 +1,6 @@ -Warning: tests/js_source.ml:3554 exceeds the margin -Warning: tests/js_source.ml:9521 exceeds the margin -Warning: tests/js_source.ml:9624 exceeds the margin -Warning: tests/js_source.ml:9643 exceeds the margin -Warning: tests/js_source.ml:9683 exceeds the margin -Warning: tests/js_source.ml:9765 exceeds the margin +Warning: tests/js_source.ml:3555 exceeds the margin +Warning: tests/js_source.ml:9522 exceeds the margin +Warning: tests/js_source.ml:9625 exceeds the margin +Warning: tests/js_source.ml:9644 exceeds the margin +Warning: tests/js_source.ml:9684 exceeds the margin +Warning: tests/js_source.ml:9766 exceeds the margin diff --git a/test/passing/tests/js_source.ml.ocp b/test/passing/tests/js_source.ml.ocp index ab48b497cd..941ea199cc 100644 --- a/test/passing/tests/js_source.ml.ocp +++ b/test/passing/tests/js_source.ml.ocp @@ -3020,9 +3020,10 @@ type (_, _) eq = Refl : ('a, 'a) eq let magic : 'a 'b. 'a -> 'b = fun (type a b) (x : a) -> let module M = - (functor (T : sig - type 'a t - end) -> + (functor + (T : sig + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) end) diff --git a/test/passing/tests/js_source.ml.ref b/test/passing/tests/js_source.ml.ref index c4a9a91e43..0d3852cd1d 100644 --- a/test/passing/tests/js_source.ml.ref +++ b/test/passing/tests/js_source.ml.ref @@ -3020,9 +3020,10 @@ type (_, _) eq = Refl : ('a, 'a) eq let magic : 'a 'b. 'a -> 'b = fun (type a b) (x : a) -> let module M = - (functor (T : sig - type 'a t - end) -> + (functor + (T : sig + type 'a t + end) -> struct let f (Refl : (a T.t, b T.t) eq) = (x :> b) end)