From 71b3ff4555ae05855769717dd791792e5ba4925a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 08:43:15 +0100 Subject: [PATCH 01/16] Experiment with uncurried mode: swap application. --- lib/4.06.1/unstable/js_playground_compiler.ml | 8 +++++++- lib/4.06.1/whole_compiler.ml | 8 +++++++- res_syntax/src/res_core.ml | 3 ++- res_syntax/src/res_parser.ml | 4 ++++ res_syntax/src/res_parser.mli | 1 + .../parsing/grammar/expressions/UncurriedByDefault.res | 7 +++++++ .../expressions/expected/UncurriedByDefault.res.txt | 5 +++++ 7 files changed, 33 insertions(+), 3 deletions(-) create mode 100644 res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res create mode 100644 res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 53c7db6f63..3e7ca3b922 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -162170,6 +162170,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } val make : ?mode:mode -> string -> string -> t @@ -162221,6 +162222,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } let err ?startPos ?endPos p error = @@ -162320,6 +162322,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; + uncurried = false; } in parserState.scanner.err <- @@ -162367,6 +162370,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in + let uncurried = p.uncurried in let res = callback p in @@ -162384,6 +162388,7 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; + p.uncurried <- uncurried; res @@ -166011,6 +166016,7 @@ and parseCallExpr p funExpr = let uncurried, args = group in let args, wrap = processUnderscoreApplication args in let exp = + let uncurried = if p.uncurried then not uncurried else uncurried in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -168726,9 +168732,9 @@ and parseAttributes p = *) and parseStandaloneAttribute p = let startPos = p.startPos in - (* XX *) Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in + if attrId.txt = "uncurried" then p.uncurried <- true; let payload = parsePayload p in (attrId, payload) diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 4679be3e16..6b2ab6604d 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -175602,6 +175602,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } val make : ?mode:mode -> string -> string -> t @@ -175653,6 +175654,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } let err ?startPos ?endPos p error = @@ -175752,6 +175754,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; + uncurried = false; } in parserState.scanner.err <- @@ -175799,6 +175802,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in + let uncurried = p.uncurried in let res = callback p in @@ -175816,6 +175820,7 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; + p.uncurried <- uncurried; res @@ -179443,6 +179448,7 @@ and parseCallExpr p funExpr = let uncurried, args = group in let args, wrap = processUnderscoreApplication args in let exp = + let uncurried = if p.uncurried then not uncurried else uncurried in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -182158,9 +182164,9 @@ and parseAttributes p = *) and parseStandaloneAttribute p = let startPos = p.startPos in - (* XX *) Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in + if attrId.txt = "uncurried" then p.uncurried <- true; let payload = parsePayload p in (attrId, payload) diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index d02320e101..d3e5a665c9 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -3614,6 +3614,7 @@ and parseCallExpr p funExpr = let uncurried, args = group in let args, wrap = processUnderscoreApplication args in let exp = + let uncurried = if p.uncurried then not uncurried else uncurried in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -6329,9 +6330,9 @@ and parseAttributes p = *) and parseStandaloneAttribute p = let startPos = p.startPos in - (* XX *) Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in + if attrId.txt = "uncurried" then p.uncurried <- true; let payload = parsePayload p in (attrId, payload) diff --git a/res_syntax/src/res_parser.ml b/res_syntax/src/res_parser.ml index 9fcdc3c5c4..d09730f35f 100644 --- a/res_syntax/src/res_parser.ml +++ b/res_syntax/src/res_parser.ml @@ -22,6 +22,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } let err ?startPos ?endPos p error = @@ -121,6 +122,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; + uncurried = false; } in parserState.scanner.err <- @@ -168,6 +170,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in + let uncurried = p.uncurried in let res = callback p in @@ -185,5 +188,6 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; + p.uncurried <- uncurried; res diff --git a/res_syntax/src/res_parser.mli b/res_syntax/src/res_parser.mli index 09b0b455f7..70e07b2819 100644 --- a/res_syntax/src/res_parser.mli +++ b/res_syntax/src/res_parser.mli @@ -21,6 +21,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; + mutable uncurried: bool; } val make : ?mode:mode -> string -> string -> t diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res new file mode 100644 index 0000000000..4ba9288a3c --- /dev/null +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -0,0 +1,7 @@ +let u = foo(3) +let c = foo(. 3) + +@@uncurried + +let u = foo(. 3) +let c = foo(3) diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt new file mode 100644 index 0000000000..62194e4dbc --- /dev/null +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -0,0 +1,5 @@ +let u = foo 3 +let c = ((foo 3)[@bs ]) +[@@@uncurried ] +let u = foo 3 +let c = ((foo 3)[@bs ]) \ No newline at end of file From a689ff4f57649162941670f0fad61abe906b41ee Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 09:11:36 +0100 Subject: [PATCH 02/16] Refactor: use "dotted" instead of "uncurried" in the parser for dotted application. --- lib/4.06.1/unstable/js_playground_compiler.ml | 122 ++++++++++-------- lib/4.06.1/whole_compiler.ml | 122 ++++++++++-------- res_syntax/src/res_core.ml | 110 +++++++++------- res_syntax/src/res_parser.ml | 8 +- res_syntax/src/res_parser.mli | 2 +- 5 files changed, 206 insertions(+), 158 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 3e7ca3b922..b38281f155 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -162170,7 +162170,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } val make : ?mode:mode -> string -> string -> t @@ -162222,7 +162222,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } let err ?startPos ?endPos p error = @@ -162322,7 +162322,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; - uncurried = false; + uncurried_by_default = false; } in parserState.scanner.err <- @@ -162370,7 +162370,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in - let uncurried = p.uncurried in + let uncurried_by_default = p.uncurried_by_default in let res = callback p in @@ -162388,7 +162388,7 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; - p.uncurried <- uncurried; + p.uncurried_by_default <- uncurried_by_default; res @@ -162576,6 +162576,12 @@ let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) +type argument = { + dotted: bool; + label: Asttypes.arg_label; + expr: Parsetree.expression; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -165851,7 +165857,7 @@ and parseSwitchExpression p = * uncurried_argument ::= * | . argument *) -and parseArgument p = +and parseArgument p : argument option = if p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore @@ -165859,7 +165865,7 @@ and parseArgument p = then match p.Parser.token with | Dot -> ( - let uncurried = true in + let dotted = true in Parser.next p; match p.token with (* apply(.) *) @@ -165869,21 +165875,21 @@ and parseArgument p = (Location.mknoloc (Longident.Lident "()")) None in - Some (uncurried, Asttypes.Nolabel, unitExpr) - | _ -> parseArgument2 p ~uncurried) - | _ -> parseArgument2 p ~uncurried:false + Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} + | _ -> parseArgument2 p ~dotted) + | _ -> parseArgument2 p ~dotted:false else None -and parseArgument2 p ~uncurried = +and parseArgument2 p ~dotted : argument option = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> let loc = mkLoc p.startPos p.endPos in Parser.next p; - let exp = + let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) in - Some (uncurried, Asttypes.Nolabel, exp) + Some {dotted; label = Nolabel; expr} | Tilde -> ( Parser.next p; (* TODO: nesting of pattern matches not intuitive for error recovery *) @@ -165903,7 +165909,7 @@ and parseArgument2 p ~uncurried = match p.Parser.token with | Question -> Parser.next p; - Some (uncurried, Asttypes.Optional ident, identExpr) + Some {dotted; label = Optional ident; expr = identExpr} | Equal -> Parser.next p; let label = @@ -165924,7 +165930,7 @@ and parseArgument2 p ~uncurried = let expr = parseConstrainedOrCoercedExpr p in {expr with pexp_attributes = propLocAttr :: expr.pexp_attributes} in - Some (uncurried, label, expr) + Some {dotted; label; expr} | Colon -> Parser.next p; let typ = parseTypExpr p in @@ -165932,12 +165938,12 @@ and parseArgument2 p ~uncurried = let expr = Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ in - Some (uncurried, Labelled ident, expr) - | _ -> Some (uncurried, Labelled ident, identExpr)) + Some {dotted; label = Labelled ident; expr} + | _ -> Some {dotted; label = Labelled ident; expr = identExpr}) | t -> Parser.err p (Diagnostics.lident t); - Some (uncurried, Nolabel, Recover.defaultExpr ())) - | _ -> Some (uncurried, Nolabel, parseConstrainedOrCoercedExpr p) + Some {dotted; label = Nolabel; expr = Recover.defaultExpr ()}) + | _ -> Some {dotted; label = Nolabel; expr = parseConstrainedOrCoercedExpr p} and parseCallExpr p funExpr = Parser.expect Lparen p; @@ -165954,20 +165960,26 @@ and parseCallExpr p funExpr = let loc = mkLoc startPos p.prevEndPos in (* No args -> unit sugar: `foo()` *) [ - ( false, - Asttypes.Nolabel, - Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) - None ); + { + dotted = false; + label = Nolabel; + expr = + Ast_helper.Exp.construct ~loc + (Location.mkloc (Longident.Lident "()") loc) + None; + }; ] | [ - ( true, - Asttypes.Nolabel, - ({ - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); - pexp_loc = loc; - pexp_attributes = []; - } as expr) ); + { + dotted = true; + label = Nolabel; + expr = + { + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); + pexp_loc = loc; + pexp_attributes = []; + } as expr; + }; ] when (not loc.loc_ghost) && p.mode = ParseForTypeChecker -> (* Since there is no syntax space for arity zero vs arity one, @@ -165983,40 +165995,44 @@ and parseCallExpr p funExpr = * Related: https://github.com/rescript-lang/syntax/issues/138 *) [ - ( true, - Asttypes.Nolabel, - Ast_helper.Exp.let_ Asttypes.Nonrecursive - [ - Ast_helper.Vb.mk - (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) - expr; - ] - (Ast_helper.Exp.ident - (Location.mknoloc (Longident.Lident "__res_unit"))) ); + { + dotted = true; + label = Nolabel; + expr = + Ast_helper.Exp.let_ Asttypes.Nonrecursive + [ + Ast_helper.Vb.mk + (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) + expr; + ] + (Ast_helper.Exp.ident + (Location.mknoloc (Longident.Lident "__res_unit"))); + }; ] | args -> args in let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in let args = match args with - | (u, lbl, expr) :: args -> - let group (grp, acc) (uncurried, lbl, expr) = - let _u, grp = grp in - if uncurried == true then - ((true, [(lbl, expr)]), (_u, List.rev grp) :: acc) - else ((_u, (lbl, expr) :: grp), acc) - in - let (_u, grp), acc = List.fold_left group ((u, [(lbl, expr)]), []) args in - List.rev ((_u, List.rev grp) :: acc) + | {dotted = d; label = lbl; expr} :: args -> + let group (grp, acc) {dotted; label = lbl; expr} = + let _d, grp = grp in + if dotted == true then ((true, [(lbl, expr)]), (_d, List.rev grp) :: acc) + else ((_d, (lbl, expr) :: grp), acc) + in + let (_d, grp), acc = List.fold_left group ((d, [(lbl, expr)]), []) args in + List.rev ((_d, List.rev grp) :: acc) | [] -> [] in let apply = List.fold_left (fun callBody group -> - let uncurried, args = group in + let dotted, args = group in let args, wrap = processUnderscoreApplication args in let exp = - let uncurried = if p.uncurried then not uncurried else uncurried in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -168734,7 +168750,7 @@ and parseStandaloneAttribute p = let startPos = p.startPos in Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in - if attrId.txt = "uncurried" then p.uncurried <- true; + if attrId.txt = "uncurried" then p.uncurried_by_default <- true; let payload = parsePayload p in (attrId, payload) diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 6b2ab6604d..1a5c22e608 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -175602,7 +175602,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } val make : ?mode:mode -> string -> string -> t @@ -175654,7 +175654,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } let err ?startPos ?endPos p error = @@ -175754,7 +175754,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; - uncurried = false; + uncurried_by_default = false; } in parserState.scanner.err <- @@ -175802,7 +175802,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in - let uncurried = p.uncurried in + let uncurried_by_default = p.uncurried_by_default in let res = callback p in @@ -175820,7 +175820,7 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; - p.uncurried <- uncurried; + p.uncurried_by_default <- uncurried_by_default; res @@ -176008,6 +176008,12 @@ let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) +type argument = { + dotted: bool; + label: Asttypes.arg_label; + expr: Parsetree.expression; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -179283,7 +179289,7 @@ and parseSwitchExpression p = * uncurried_argument ::= * | . argument *) -and parseArgument p = +and parseArgument p : argument option = if p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore @@ -179291,7 +179297,7 @@ and parseArgument p = then match p.Parser.token with | Dot -> ( - let uncurried = true in + let dotted = true in Parser.next p; match p.token with (* apply(.) *) @@ -179301,21 +179307,21 @@ and parseArgument p = (Location.mknoloc (Longident.Lident "()")) None in - Some (uncurried, Asttypes.Nolabel, unitExpr) - | _ -> parseArgument2 p ~uncurried) - | _ -> parseArgument2 p ~uncurried:false + Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} + | _ -> parseArgument2 p ~dotted) + | _ -> parseArgument2 p ~dotted:false else None -and parseArgument2 p ~uncurried = +and parseArgument2 p ~dotted : argument option = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> let loc = mkLoc p.startPos p.endPos in Parser.next p; - let exp = + let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) in - Some (uncurried, Asttypes.Nolabel, exp) + Some {dotted; label = Nolabel; expr} | Tilde -> ( Parser.next p; (* TODO: nesting of pattern matches not intuitive for error recovery *) @@ -179335,7 +179341,7 @@ and parseArgument2 p ~uncurried = match p.Parser.token with | Question -> Parser.next p; - Some (uncurried, Asttypes.Optional ident, identExpr) + Some {dotted; label = Optional ident; expr = identExpr} | Equal -> Parser.next p; let label = @@ -179356,7 +179362,7 @@ and parseArgument2 p ~uncurried = let expr = parseConstrainedOrCoercedExpr p in {expr with pexp_attributes = propLocAttr :: expr.pexp_attributes} in - Some (uncurried, label, expr) + Some {dotted; label; expr} | Colon -> Parser.next p; let typ = parseTypExpr p in @@ -179364,12 +179370,12 @@ and parseArgument2 p ~uncurried = let expr = Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ in - Some (uncurried, Labelled ident, expr) - | _ -> Some (uncurried, Labelled ident, identExpr)) + Some {dotted; label = Labelled ident; expr} + | _ -> Some {dotted; label = Labelled ident; expr = identExpr}) | t -> Parser.err p (Diagnostics.lident t); - Some (uncurried, Nolabel, Recover.defaultExpr ())) - | _ -> Some (uncurried, Nolabel, parseConstrainedOrCoercedExpr p) + Some {dotted; label = Nolabel; expr = Recover.defaultExpr ()}) + | _ -> Some {dotted; label = Nolabel; expr = parseConstrainedOrCoercedExpr p} and parseCallExpr p funExpr = Parser.expect Lparen p; @@ -179386,20 +179392,26 @@ and parseCallExpr p funExpr = let loc = mkLoc startPos p.prevEndPos in (* No args -> unit sugar: `foo()` *) [ - ( false, - Asttypes.Nolabel, - Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) - None ); + { + dotted = false; + label = Nolabel; + expr = + Ast_helper.Exp.construct ~loc + (Location.mkloc (Longident.Lident "()") loc) + None; + }; ] | [ - ( true, - Asttypes.Nolabel, - ({ - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); - pexp_loc = loc; - pexp_attributes = []; - } as expr) ); + { + dotted = true; + label = Nolabel; + expr = + { + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); + pexp_loc = loc; + pexp_attributes = []; + } as expr; + }; ] when (not loc.loc_ghost) && p.mode = ParseForTypeChecker -> (* Since there is no syntax space for arity zero vs arity one, @@ -179415,40 +179427,44 @@ and parseCallExpr p funExpr = * Related: https://github.com/rescript-lang/syntax/issues/138 *) [ - ( true, - Asttypes.Nolabel, - Ast_helper.Exp.let_ Asttypes.Nonrecursive - [ - Ast_helper.Vb.mk - (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) - expr; - ] - (Ast_helper.Exp.ident - (Location.mknoloc (Longident.Lident "__res_unit"))) ); + { + dotted = true; + label = Nolabel; + expr = + Ast_helper.Exp.let_ Asttypes.Nonrecursive + [ + Ast_helper.Vb.mk + (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) + expr; + ] + (Ast_helper.Exp.ident + (Location.mknoloc (Longident.Lident "__res_unit"))); + }; ] | args -> args in let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in let args = match args with - | (u, lbl, expr) :: args -> - let group (grp, acc) (uncurried, lbl, expr) = - let _u, grp = grp in - if uncurried == true then - ((true, [(lbl, expr)]), (_u, List.rev grp) :: acc) - else ((_u, (lbl, expr) :: grp), acc) - in - let (_u, grp), acc = List.fold_left group ((u, [(lbl, expr)]), []) args in - List.rev ((_u, List.rev grp) :: acc) + | {dotted = d; label = lbl; expr} :: args -> + let group (grp, acc) {dotted; label = lbl; expr} = + let _d, grp = grp in + if dotted == true then ((true, [(lbl, expr)]), (_d, List.rev grp) :: acc) + else ((_d, (lbl, expr) :: grp), acc) + in + let (_d, grp), acc = List.fold_left group ((d, [(lbl, expr)]), []) args in + List.rev ((_d, List.rev grp) :: acc) | [] -> [] in let apply = List.fold_left (fun callBody group -> - let uncurried, args = group in + let dotted, args = group in let args, wrap = processUnderscoreApplication args in let exp = - let uncurried = if p.uncurried then not uncurried else uncurried in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -182166,7 +182182,7 @@ and parseStandaloneAttribute p = let startPos = p.startPos in Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in - if attrId.txt = "uncurried" then p.uncurried <- true; + if attrId.txt = "uncurried" then p.uncurried_by_default <- true; let payload = parsePayload p in (attrId, payload) diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index d3e5a665c9..735fab6e24 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -174,6 +174,12 @@ let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) +type argument = { + dotted: bool; + label: Asttypes.arg_label; + expr: Parsetree.expression; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -3449,7 +3455,7 @@ and parseSwitchExpression p = * uncurried_argument ::= * | . argument *) -and parseArgument p = +and parseArgument p : argument option = if p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore @@ -3457,7 +3463,7 @@ and parseArgument p = then match p.Parser.token with | Dot -> ( - let uncurried = true in + let dotted = true in Parser.next p; match p.token with (* apply(.) *) @@ -3467,21 +3473,21 @@ and parseArgument p = (Location.mknoloc (Longident.Lident "()")) None in - Some (uncurried, Asttypes.Nolabel, unitExpr) - | _ -> parseArgument2 p ~uncurried) - | _ -> parseArgument2 p ~uncurried:false + Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} + | _ -> parseArgument2 p ~dotted) + | _ -> parseArgument2 p ~dotted:false else None -and parseArgument2 p ~uncurried = +and parseArgument2 p ~dotted : argument option = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> let loc = mkLoc p.startPos p.endPos in Parser.next p; - let exp = + let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) in - Some (uncurried, Asttypes.Nolabel, exp) + Some {dotted; label = Nolabel; expr} | Tilde -> ( Parser.next p; (* TODO: nesting of pattern matches not intuitive for error recovery *) @@ -3501,7 +3507,7 @@ and parseArgument2 p ~uncurried = match p.Parser.token with | Question -> Parser.next p; - Some (uncurried, Asttypes.Optional ident, identExpr) + Some {dotted; label = Optional ident; expr = identExpr} | Equal -> Parser.next p; let label = @@ -3522,7 +3528,7 @@ and parseArgument2 p ~uncurried = let expr = parseConstrainedOrCoercedExpr p in {expr with pexp_attributes = propLocAttr :: expr.pexp_attributes} in - Some (uncurried, label, expr) + Some {dotted; label; expr} | Colon -> Parser.next p; let typ = parseTypExpr p in @@ -3530,12 +3536,12 @@ and parseArgument2 p ~uncurried = let expr = Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ in - Some (uncurried, Labelled ident, expr) - | _ -> Some (uncurried, Labelled ident, identExpr)) + Some {dotted; label = Labelled ident; expr} + | _ -> Some {dotted; label = Labelled ident; expr = identExpr}) | t -> Parser.err p (Diagnostics.lident t); - Some (uncurried, Nolabel, Recover.defaultExpr ())) - | _ -> Some (uncurried, Nolabel, parseConstrainedOrCoercedExpr p) + Some {dotted; label = Nolabel; expr = Recover.defaultExpr ()}) + | _ -> Some {dotted; label = Nolabel; expr = parseConstrainedOrCoercedExpr p} and parseCallExpr p funExpr = Parser.expect Lparen p; @@ -3552,20 +3558,26 @@ and parseCallExpr p funExpr = let loc = mkLoc startPos p.prevEndPos in (* No args -> unit sugar: `foo()` *) [ - ( false, - Asttypes.Nolabel, - Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident "()") loc) - None ); + { + dotted = false; + label = Nolabel; + expr = + Ast_helper.Exp.construct ~loc + (Location.mkloc (Longident.Lident "()") loc) + None; + }; ] | [ - ( true, - Asttypes.Nolabel, - ({ - pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); - pexp_loc = loc; - pexp_attributes = []; - } as expr) ); + { + dotted = true; + label = Nolabel; + expr = + { + pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); + pexp_loc = loc; + pexp_attributes = []; + } as expr; + }; ] when (not loc.loc_ghost) && p.mode = ParseForTypeChecker -> (* Since there is no syntax space for arity zero vs arity one, @@ -3581,40 +3593,44 @@ and parseCallExpr p funExpr = * Related: https://github.com/rescript-lang/syntax/issues/138 *) [ - ( true, - Asttypes.Nolabel, - Ast_helper.Exp.let_ Asttypes.Nonrecursive - [ - Ast_helper.Vb.mk - (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) - expr; - ] - (Ast_helper.Exp.ident - (Location.mknoloc (Longident.Lident "__res_unit"))) ); + { + dotted = true; + label = Nolabel; + expr = + Ast_helper.Exp.let_ Asttypes.Nonrecursive + [ + Ast_helper.Vb.mk + (Ast_helper.Pat.var (Location.mknoloc "__res_unit")) + expr; + ] + (Ast_helper.Exp.ident + (Location.mknoloc (Longident.Lident "__res_unit"))); + }; ] | args -> args in let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in let args = match args with - | (u, lbl, expr) :: args -> - let group (grp, acc) (uncurried, lbl, expr) = - let _u, grp = grp in - if uncurried == true then - ((true, [(lbl, expr)]), (_u, List.rev grp) :: acc) - else ((_u, (lbl, expr) :: grp), acc) + | {dotted = d; label = lbl; expr} :: args -> + let group (grp, acc) {dotted; label = lbl; expr} = + let _d, grp = grp in + if dotted == true then ((true, [(lbl, expr)]), (_d, List.rev grp) :: acc) + else ((_d, (lbl, expr) :: grp), acc) in - let (_u, grp), acc = List.fold_left group ((u, [(lbl, expr)]), []) args in - List.rev ((_u, List.rev grp) :: acc) + let (_d, grp), acc = List.fold_left group ((d, [(lbl, expr)]), []) args in + List.rev ((_d, List.rev grp) :: acc) | [] -> [] in let apply = List.fold_left (fun callBody group -> - let uncurried, args = group in + let dotted, args = group in let args, wrap = processUnderscoreApplication args in let exp = - let uncurried = if p.uncurried then not uncurried else uncurried in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in if uncurried then let attrs = [uncurryAttr] in Ast_helper.Exp.apply ~loc ~attrs callBody args @@ -6332,7 +6348,7 @@ and parseStandaloneAttribute p = let startPos = p.startPos in Parser.expect AtAt p; let attrId = parseAttributeId ~startPos p in - if attrId.txt = "uncurried" then p.uncurried <- true; + if attrId.txt = "uncurried" then p.uncurried_by_default <- true; let payload = parsePayload p in (attrId, payload) diff --git a/res_syntax/src/res_parser.ml b/res_syntax/src/res_parser.ml index d09730f35f..04ead296dc 100644 --- a/res_syntax/src/res_parser.ml +++ b/res_syntax/src/res_parser.ml @@ -22,7 +22,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } let err ?startPos ?endPos p error = @@ -122,7 +122,7 @@ let make ?(mode = ParseForTypeChecker) src filename = diagnostics = []; comments = []; regions = [ref Report]; - uncurried = false; + uncurried_by_default = false; } in parserState.scanner.err <- @@ -170,7 +170,7 @@ let lookahead p callback = let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in - let uncurried = p.uncurried in + let uncurried_by_default = p.uncurried_by_default in let res = callback p in @@ -188,6 +188,6 @@ let lookahead p callback = p.errors <- errors; p.diagnostics <- diagnostics; p.comments <- comments; - p.uncurried <- uncurried; + p.uncurried_by_default <- uncurried_by_default; res diff --git a/res_syntax/src/res_parser.mli b/res_syntax/src/res_parser.mli index 70e07b2819..b4d1517ea1 100644 --- a/res_syntax/src/res_parser.mli +++ b/res_syntax/src/res_parser.mli @@ -21,7 +21,7 @@ type t = { mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; mutable regions: regionStatus ref list; - mutable uncurried: bool; + mutable uncurried_by_default: bool; } val make : ?mode:mode -> string -> string -> t From 9b846feda8f695cb9cb92357ab2c474935589926 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 09:25:31 +0100 Subject: [PATCH 03/16] Refactor: rename uncurried to dotted in labelled parameters. --- lib/4.06.1/unstable/js_playground_compiler.ml | 36 +++++++++---------- lib/4.06.1/whole_compiler.ml | 36 +++++++++---------- res_syntax/src/res_core.ml | 36 +++++++++---------- 3 files changed, 54 insertions(+), 54 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index b38281f155..5df7bb6da8 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -162591,7 +162591,7 @@ type typDefOrExt = type labelledParameter = | TermParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; label: Asttypes.arg_label; expr: Parsetree.expression option; @@ -162599,7 +162599,7 @@ type labelledParameter = pos: Lexing.position; } | TypeParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; locs: string Location.loc list; pos: Lexing.position; @@ -163925,7 +163925,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {uncurried = true} :: _ + | TermParameter {dotted = true} :: _ when match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> @@ -163941,7 +163941,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context match parameter with | TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = defaultExpr; @@ -163952,7 +163952,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if uncurried then + if dotted then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -163972,8 +163972,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None, 1 ) else (funExpr, arity + 1) - | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> + let attrs = if dotted then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in @@ -164004,12 +164004,12 @@ and parseParameter p = || Grammar.isPatternStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Token.Dot in + let dotted = Parser.optional p Token.Dot in let attrs = parseAttributes p in if p.Parser.token = Typ then ( Parser.next p; let lidents = parseLidentList p in - Some (TypeParameter {uncurried; attrs; locs = lidents; pos = startPos})) + Some (TypeParameter {dotted; attrs; locs = lidents; pos = startPos})) else let attrs, lbl, pat = match p.Parser.token with @@ -164083,13 +164083,13 @@ and parseParameter p = Parser.next p; Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) | _ -> let expr = parseConstrainedOrCoercedExpr p in Some (TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = Some expr; @@ -164099,7 +164099,7 @@ and parseParameter p = | _ -> Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) else None and parseParameterList p = @@ -164126,7 +164126,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -164140,7 +164140,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -164162,7 +164162,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -164184,7 +164184,7 @@ and parseParameters p = [ TermParameter { - uncurried = true; + dotted = true; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -164195,7 +164195,7 @@ and parseParameters p = | _ -> ( match parseParameterList p with | TermParameter p :: rest -> - TermParameter {p with uncurried = true; pos = startPos} :: rest + TermParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -165291,7 +165291,7 @@ and parseBracedOrRecordExpr p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 1a5c22e608..66b8def116 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -176023,7 +176023,7 @@ type typDefOrExt = type labelledParameter = | TermParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; label: Asttypes.arg_label; expr: Parsetree.expression option; @@ -176031,7 +176031,7 @@ type labelledParameter = pos: Lexing.position; } | TypeParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; locs: string Location.loc list; pos: Lexing.position; @@ -177357,7 +177357,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {uncurried = true} :: _ + | TermParameter {dotted = true} :: _ when match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> @@ -177373,7 +177373,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context match parameter with | TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = defaultExpr; @@ -177384,7 +177384,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if uncurried then + if dotted then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -177404,8 +177404,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None, 1 ) else (funExpr, arity + 1) - | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> + let attrs = if dotted then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in @@ -177436,12 +177436,12 @@ and parseParameter p = || Grammar.isPatternStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Token.Dot in + let dotted = Parser.optional p Token.Dot in let attrs = parseAttributes p in if p.Parser.token = Typ then ( Parser.next p; let lidents = parseLidentList p in - Some (TypeParameter {uncurried; attrs; locs = lidents; pos = startPos})) + Some (TypeParameter {dotted; attrs; locs = lidents; pos = startPos})) else let attrs, lbl, pat = match p.Parser.token with @@ -177515,13 +177515,13 @@ and parseParameter p = Parser.next p; Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) | _ -> let expr = parseConstrainedOrCoercedExpr p in Some (TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = Some expr; @@ -177531,7 +177531,7 @@ and parseParameter p = | _ -> Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) else None and parseParameterList p = @@ -177558,7 +177558,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -177572,7 +177572,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -177594,7 +177594,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -177616,7 +177616,7 @@ and parseParameters p = [ TermParameter { - uncurried = true; + dotted = true; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -177627,7 +177627,7 @@ and parseParameters p = | _ -> ( match parseParameterList p with | TermParameter p :: rest -> - TermParameter {p with uncurried = true; pos = startPos} :: rest + TermParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -178723,7 +178723,7 @@ and parseBracedOrRecordExpr p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 735fab6e24..9b0b6a6c64 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -189,7 +189,7 @@ type typDefOrExt = type labelledParameter = | TermParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; label: Asttypes.arg_label; expr: Parsetree.expression option; @@ -197,7 +197,7 @@ type labelledParameter = pos: Lexing.position; } | TypeParameter of { - uncurried: bool; + dotted: bool; attrs: Parsetree.attributes; locs: string Location.loc list; pos: Lexing.position; @@ -1523,7 +1523,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {uncurried = true} :: _ + | TermParameter {dotted = true} :: _ when match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> @@ -1539,7 +1539,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context match parameter with | TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = defaultExpr; @@ -1550,7 +1550,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if uncurried then + if dotted then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -1570,8 +1570,8 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context None, 1 ) else (funExpr, arity + 1) - | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> - let attrs = if uncurried then uncurryAttr :: attrs else attrs in + | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> + let attrs = if dotted then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in @@ -1602,12 +1602,12 @@ and parseParameter p = || Grammar.isPatternStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Token.Dot in + let dotted = Parser.optional p Token.Dot in let attrs = parseAttributes p in if p.Parser.token = Typ then ( Parser.next p; let lidents = parseLidentList p in - Some (TypeParameter {uncurried; attrs; locs = lidents; pos = startPos})) + Some (TypeParameter {dotted; attrs; locs = lidents; pos = startPos})) else let attrs, lbl, pat = match p.Parser.token with @@ -1681,13 +1681,13 @@ and parseParameter p = Parser.next p; Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) | _ -> let expr = parseConstrainedOrCoercedExpr p in Some (TermParameter { - uncurried; + dotted; attrs; label = lbl; expr = Some expr; @@ -1697,7 +1697,7 @@ and parseParameter p = | _ -> Some (TermParameter - {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) else None and parseParameterList p = @@ -1724,7 +1724,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -1738,7 +1738,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -1760,7 +1760,7 @@ and parseParameters p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -1782,7 +1782,7 @@ and parseParameters p = [ TermParameter { - uncurried = true; + dotted = true; attrs = []; label = Asttypes.Nolabel; expr = None; @@ -1793,7 +1793,7 @@ and parseParameters p = | _ -> ( match parseParameterList p with | TermParameter p :: rest -> - TermParameter {p with uncurried = true; pos = startPos} :: rest + TermParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) | _ -> parseParameterList p) | token -> @@ -2889,7 +2889,7 @@ and parseBracedOrRecordExpr p = [ TermParameter { - uncurried = false; + dotted = false; attrs = []; label = Asttypes.Nolabel; expr = None; From 83214a8c4601ebaa1e99f6b0b16c09ff4f4c7763 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 16:08:09 +0100 Subject: [PATCH 04/16] Uncurried mode support when parsing function declarations. --- lib/4.06.1/unstable/js_playground_compiler.ml | 16 ++++++++--- lib/4.06.1/whole_compiler.ml | 16 ++++++++--- res_syntax/src/res_core.ml | 16 ++++++++--- .../expressions/UncurriedByDefault.res | 19 ++++++++++--- .../expected/UncurriedByDefault.res.txt | 28 ++++++++++++++++--- 5 files changed, 75 insertions(+), 20 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 5df7bb6da8..ba52d5d02c 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -163925,8 +163925,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {dotted = true} :: _ - when match body.pexp_desc with + | TermParameter {dotted} :: _ + when (if p.uncurried_by_default then not dotted else dotted) + && + match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> { @@ -163952,7 +163954,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -163973,7 +163978,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context 1 ) else (funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let attrs = if dotted then uncurryAttr :: attrs else attrs in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + let attrs = if uncurried then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 66b8def116..9ab08f0d42 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -177357,8 +177357,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {dotted = true} :: _ - when match body.pexp_desc with + | TermParameter {dotted} :: _ + when (if p.uncurried_by_default then not dotted else dotted) + && + match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> { @@ -177384,7 +177386,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -177405,7 +177410,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context 1 ) else (funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let attrs = if dotted then uncurryAttr :: attrs else attrs in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + let attrs = if uncurried then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 9b0b6a6c64..e742d1e3c1 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1523,8 +1523,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let endPos = p.prevEndPos in let body = match parameters with - | TermParameter {dotted = true} :: _ - when match body.pexp_desc with + | TermParameter {dotted} :: _ + when (if p.uncurried_by_default then not dotted else dotted) + && + match body.pexp_desc with | Pexp_fun _ -> true | _ -> false -> { @@ -1550,7 +1552,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let funExpr = Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 @@ -1571,7 +1576,10 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context 1 ) else (funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> - let attrs = if dotted then uncurryAttr :: attrs else attrs in + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + let attrs = if uncurried then uncurryAttr :: attrs else attrs in (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) parameters (body, 1) in diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 4ba9288a3c..7e56fb7636 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -1,7 +1,18 @@ -let u = foo(3) -let c = foo(. 3) +let cApp = foo(3) +let uApp = foo(. 3) + +let cFun = x => 3 +let uFun = (.x) => 3 +let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +let bracesFun = (. x) => y => x+y + @@uncurried -let u = foo(. 3) -let c = foo(3) +let cApp = foo(. 3) +let uApp = foo(3) + +let cFun = (. x) => 3 +let uFun = x => 3 +let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +let bracesFun = x => (. y) => x+y diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 62194e4dbc..73a141ca3c 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -1,5 +1,25 @@ -let u = foo 3 -let c = ((foo 3)[@bs ]) +let cApp = foo 3 +let uApp = ((foo 3)[@bs ]) +let cFun x = 3 +let uFun = { Js.Fn.I1 = (fun x -> 3) } +let mixFun a = + { + Js.Fn.I2 = + (fun b -> + fun c -> + fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + } +let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } [@@@uncurried ] -let u = foo 3 -let c = ((foo 3)[@bs ]) \ No newline at end of file +let cApp = foo 3 +let uApp = ((foo 3)[@bs ]) +let cFun x = 3 +let uFun = { Js.Fn.I1 = (fun x -> 3) } +let mixFun a = + { + Js.Fn.I2 = + (fun b -> + fun c -> + fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + } +let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } \ No newline at end of file From fd6b4a69bb9f4b8c2b18b187359863f77d389f62 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 16:21:57 +0100 Subject: [PATCH 05/16] Refactor: use "dotted" instead of "uncurried" when parsing types. --- lib/4.06.1/unstable/js_playground_compiler.ml | 35 ++++++++++++------- lib/4.06.1/whole_compiler.ml | 35 ++++++++++++------- res_syntax/src/res_core.ml | 35 ++++++++++++------- 3 files changed, 66 insertions(+), 39 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index ba52d5d02c..f0a7cea24a 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -162582,6 +162582,14 @@ type argument = { expr: Parsetree.expression; } +type typeParameter = { + dotted: bool; + attrs: Ast_helper.attrs; + label: Asttypes.arg_label; + typ: Parsetree.core_type; + startPos: Lexing.position; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -163988,7 +163996,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} (* - * uncurried_parameter ::= + * dotted_parameter ::= * | . parameter * * parameter ::= @@ -165862,7 +165870,7 @@ and parseSwitchExpression p = * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type * - * uncurried_argument ::= + * dotted_argument ::= * | . argument *) and parseArgument p : argument option = @@ -166491,7 +166499,7 @@ and parseTypeAlias p typ = * | attrs ~ident: type_expr -> attrs are on the arrow * | attrs type_expr -> attrs are here part of the type_expr * - * uncurried_type_parameter ::= + * dotted_type_parameter ::= * | . type_parameter *) and parseTypeParameter p = @@ -166501,7 +166509,7 @@ and parseTypeParameter p = || Grammar.isTypExprStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Dot in + let dotted = Parser.optional p Dot in let attrs = parseAttributes p in match p.Parser.token with | Tilde -> ( @@ -166519,8 +166527,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | Lident _ -> ( let name, loc = parseLident p in match p.token with @@ -166538,8 +166546,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in let args = parseTypeConstructorArgs ~constrName:constr p in @@ -166551,13 +166559,14 @@ and parseTypeParameter p = let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in let typ = parseTypeAlias p typ in - Some (uncurried, [], Asttypes.Nolabel, typ, startPos)) + Some {dotted; attrs = []; label = Nolabel; typ; startPos}) | _ -> let typ = parseTypExpr p in let typWithAttributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in - Some (uncurried, [], Asttypes.Nolabel, typWithAttributes, startPos) + Some + {dotted; attrs = []; label = Nolabel; typ = typWithAttributes; startPos} else None (* (int, ~x:string, float) *) @@ -166570,7 +166579,7 @@ and parseTypeParameters p = let loc = mkLoc startPos p.prevEndPos in let unitConstr = Location.mkloc (Longident.Lident "unit") loc in let typ = Ast_helper.Typ.constr unitConstr [] in - [(false, [], Asttypes.Nolabel, typ, startPos)] + [{dotted = false; attrs = []; label = Nolabel; typ; startPos}] | _ -> let params = parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen @@ -166610,8 +166619,8 @@ and parseEs6ArrowType ~attrs p = let endPos = p.prevEndPos in let typ = List.fold_right - (fun (uncurried, attrs, argLbl, (typ : Parsetree.core_type), startPos) t -> - if uncurried then + (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + if dotted then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 9ab08f0d42..a50c5fac0e 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -176014,6 +176014,14 @@ type argument = { expr: Parsetree.expression; } +type typeParameter = { + dotted: bool; + attrs: Ast_helper.attrs; + label: Asttypes.arg_label; + typ: Parsetree.core_type; + startPos: Lexing.position; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -177420,7 +177428,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} (* - * uncurried_parameter ::= + * dotted_parameter ::= * | . parameter * * parameter ::= @@ -179294,7 +179302,7 @@ and parseSwitchExpression p = * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type * - * uncurried_argument ::= + * dotted_argument ::= * | . argument *) and parseArgument p : argument option = @@ -179923,7 +179931,7 @@ and parseTypeAlias p typ = * | attrs ~ident: type_expr -> attrs are on the arrow * | attrs type_expr -> attrs are here part of the type_expr * - * uncurried_type_parameter ::= + * dotted_type_parameter ::= * | . type_parameter *) and parseTypeParameter p = @@ -179933,7 +179941,7 @@ and parseTypeParameter p = || Grammar.isTypExprStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Dot in + let dotted = Parser.optional p Dot in let attrs = parseAttributes p in match p.Parser.token with | Tilde -> ( @@ -179951,8 +179959,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | Lident _ -> ( let name, loc = parseLident p in match p.token with @@ -179970,8 +179978,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in let args = parseTypeConstructorArgs ~constrName:constr p in @@ -179983,13 +179991,14 @@ and parseTypeParameter p = let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in let typ = parseTypeAlias p typ in - Some (uncurried, [], Asttypes.Nolabel, typ, startPos)) + Some {dotted; attrs = []; label = Nolabel; typ; startPos}) | _ -> let typ = parseTypExpr p in let typWithAttributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in - Some (uncurried, [], Asttypes.Nolabel, typWithAttributes, startPos) + Some + {dotted; attrs = []; label = Nolabel; typ = typWithAttributes; startPos} else None (* (int, ~x:string, float) *) @@ -180002,7 +180011,7 @@ and parseTypeParameters p = let loc = mkLoc startPos p.prevEndPos in let unitConstr = Location.mkloc (Longident.Lident "unit") loc in let typ = Ast_helper.Typ.constr unitConstr [] in - [(false, [], Asttypes.Nolabel, typ, startPos)] + [{dotted = false; attrs = []; label = Nolabel; typ; startPos}] | _ -> let params = parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen @@ -180042,8 +180051,8 @@ and parseEs6ArrowType ~attrs p = let endPos = p.prevEndPos in let typ = List.fold_right - (fun (uncurried, attrs, argLbl, (typ : Parsetree.core_type), startPos) t -> - if uncurried then + (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + if dotted then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index e742d1e3c1..d341ec66e4 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -180,6 +180,14 @@ type argument = { expr: Parsetree.expression; } +type typeParameter = { + dotted: bool; + attrs: Ast_helper.attrs; + label: Asttypes.arg_label; + typ: Parsetree.core_type; + startPos: Lexing.position; +} + type typDefOrExt = | TypeDef of { recFlag: Asttypes.rec_flag; @@ -1586,7 +1594,7 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} (* - * uncurried_parameter ::= + * dotted_parameter ::= * | . parameter * * parameter ::= @@ -3460,7 +3468,7 @@ and parseSwitchExpression p = * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type * - * uncurried_argument ::= + * dotted_argument ::= * | . argument *) and parseArgument p : argument option = @@ -4089,7 +4097,7 @@ and parseTypeAlias p typ = * | attrs ~ident: type_expr -> attrs are on the arrow * | attrs type_expr -> attrs are here part of the type_expr * - * uncurried_type_parameter ::= + * dotted_type_parameter ::= * | . type_parameter *) and parseTypeParameter p = @@ -4099,7 +4107,7 @@ and parseTypeParameter p = || Grammar.isTypExprStart p.token then let startPos = p.Parser.startPos in - let uncurried = Parser.optional p Dot in + let dotted = Parser.optional p Dot in let attrs = parseAttributes p in match p.Parser.token with | Tilde -> ( @@ -4117,8 +4125,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | Lident _ -> ( let name, loc = parseLident p in match p.token with @@ -4136,8 +4144,8 @@ and parseTypeParameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) - | _ -> Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos)) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in let args = parseTypeConstructorArgs ~constrName:constr p in @@ -4149,13 +4157,14 @@ and parseTypeParameter p = let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in let typ = parseTypeAlias p typ in - Some (uncurried, [], Asttypes.Nolabel, typ, startPos)) + Some {dotted; attrs = []; label = Nolabel; typ; startPos}) | _ -> let typ = parseTypExpr p in let typWithAttributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in - Some (uncurried, [], Asttypes.Nolabel, typWithAttributes, startPos) + Some + {dotted; attrs = []; label = Nolabel; typ = typWithAttributes; startPos} else None (* (int, ~x:string, float) *) @@ -4168,7 +4177,7 @@ and parseTypeParameters p = let loc = mkLoc startPos p.prevEndPos in let unitConstr = Location.mkloc (Longident.Lident "unit") loc in let typ = Ast_helper.Typ.constr unitConstr [] in - [(false, [], Asttypes.Nolabel, typ, startPos)] + [{dotted = false; attrs = []; label = Nolabel; typ; startPos}] | _ -> let params = parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen @@ -4208,8 +4217,8 @@ and parseEs6ArrowType ~attrs p = let endPos = p.prevEndPos in let typ = List.fold_right - (fun (uncurried, attrs, argLbl, (typ : Parsetree.core_type), startPos) t -> - if uncurried then + (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + if dotted then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true From 13905a4bc592657e2e58de76f17963129a8717af Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Fri, 11 Nov 2022 16:48:39 +0100 Subject: [PATCH 06/16] Uncurried mode support for types. --- lib/4.06.1/unstable/js_playground_compiler.ml | 12 +++++++++-- lib/4.06.1/whole_compiler.ml | 12 +++++++++-- res_syntax/src/res_core.ml | 12 +++++++++-- .../expressions/UncurriedByDefault.res | 9 +++++++++ .../expected/UncurriedByDefault.res.txt | 20 ++++++++++++++++++- 5 files changed, 58 insertions(+), 7 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index f0a7cea24a..33aa370387 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -166620,7 +166620,10 @@ and parseEs6ArrowType ~attrs p = let typ = List.fold_right (fun {dotted; attrs; label = argLbl; typ; startPos} t -> - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -166697,7 +166700,12 @@ and parseArrowTypeRest ~es6Arrow ~startPos typ p = Parser.next p; let returnType = parseTypExpr ~alias:false p in let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType + let arrowTyp = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in + if p.uncurried_by_default then + Ast_helper.Typ.constr ~loc + {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc} + [arrowTyp] + else arrowTyp | _ -> typ and parseTypExprRegion p = diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index a50c5fac0e..d84b891999 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -180052,7 +180052,10 @@ and parseEs6ArrowType ~attrs p = let typ = List.fold_right (fun {dotted; attrs; label = argLbl; typ; startPos} t -> - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -180129,7 +180132,12 @@ and parseArrowTypeRest ~es6Arrow ~startPos typ p = Parser.next p; let returnType = parseTypExpr ~alias:false p in let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType + let arrowTyp = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in + if p.uncurried_by_default then + Ast_helper.Typ.constr ~loc + {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc} + [arrowTyp] + else arrowTyp | _ -> typ and parseTypExprRegion p = diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index d341ec66e4..9fc5ff5f97 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -4218,7 +4218,10 @@ and parseEs6ArrowType ~attrs p = let typ = List.fold_right (fun {dotted; attrs; label = argLbl; typ; startPos} t -> - if dotted then + let uncurried = + if p.uncurried_by_default then not dotted else dotted + in + if uncurried then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -4295,7 +4298,12 @@ and parseArrowTypeRest ~es6Arrow ~startPos typ p = Parser.next p; let returnType = parseTypExpr ~alias:false p in let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType + let arrowTyp = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in + if p.uncurried_by_default then + Ast_helper.Typ.constr ~loc + {txt = Ldot (Ldot (Lident "Js", "Fn"), "arity1"); loc} + [arrowTyp] + else arrowTyp | _ -> typ and parseTypExprRegion p = diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 7e56fb7636..2cc753d699 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -6,6 +6,10 @@ let uFun = (.x) => 3 let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 let bracesFun = (. x) => y => x+y +type cTyp = string => int +type uTyp = (. string) => int +type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int +type bTyp = (. string) => string => int @@uncurried @@ -16,3 +20,8 @@ let cFun = (. x) => 3 let uFun = x => 3 let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 let bracesFun = x => (. y) => x+y + +type cTyp = (. string) => int +type uTyp = string => int +type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +type bTyp = string => (. string) => int diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 73a141ca3c..189cdb59f0 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -10,6 +10,15 @@ let mixFun a = fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) } let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } +type nonrec cTyp = string -> int +type nonrec uTyp = (string -> int) Js.Fn.arity1 +type nonrec mixTyp = + string -> + (string -> + string -> + string -> string -> string -> string -> (string -> int) Js.Fn.arity1) + Js.Fn.arity6 +type nonrec bTyp = (string -> string -> int) Js.Fn.arity2 [@@@uncurried ] let cApp = foo 3 let uApp = ((foo 3)[@bs ]) @@ -22,4 +31,13 @@ let mixFun a = fun c -> fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) } -let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } \ No newline at end of file +let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } +type nonrec cTyp = string -> int +type nonrec uTyp = (string -> int) Js.Fn.arity1 +type nonrec mixTyp = + string -> + (string -> + string -> + string -> string -> string -> string -> (string -> int) Js.Fn.arity1) + Js.Fn.arity6 +type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 \ No newline at end of file From 35ccfe8b43d3fee8d77ae20054616e7184883c69 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 07:38:12 +0100 Subject: [PATCH 07/16] Refactor: introduce state in printer (instead of passing customLayout). --- lib/4.06.1/unstable/js_compiler.ml | 1084 +++++++---------- lib/4.06.1/unstable/js_playground_compiler.ml | 1084 +++++++---------- lib/4.06.1/whole_compiler.ml | 1084 +++++++---------- res_syntax/src/res_printer.ml | 1084 +++++++---------- 4 files changed, 1896 insertions(+), 2440 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 306b3f0e98..4c6c2dcb95 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -53637,19 +53637,29 @@ let printOptionalLabel attrs = if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" else Doc.nil -let customLayoutThreshold = 2 +module State = struct + let customLayoutThreshold = 2 -let rec printStructure ~customLayout (s : Parsetree.structure) t = + type t = {customLayout: int; uncurried: bool} + + let init = {customLayout = 0; uncurried = false} + + let nextCustomLayout t = {t with customLayout = t.customLayout + 1} + + let shouldBreakCallback t = t.customLayout > customLayoutThreshold +end + +let rec printStructure ~state (s : Parsetree.structure) t = match s with | [] -> printCommentsInsideFile t | structure -> printList ~getLoc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(printStructureItem ~customLayout) + ~print:(printStructureItem ~state) t -and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = +and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = match si.pstr_desc with | Pstr_value (rec_flag, valueBindings) -> let recFlag = @@ -53657,58 +53667,56 @@ and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl + printValueBindings ~state ~recFlag valueBindings cmtTbl | Pstr_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl | Pstr_primitive valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Pstr_eval (expr, attrs) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.structureExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] | Pstr_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Pstr_include includeDeclaration -> - printIncludeDeclaration ~customLayout includeDeclaration cmtTbl + printIncludeDeclaration ~state includeDeclaration cmtTbl | Pstr_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Pstr_module moduleBinding -> - printModuleBinding ~customLayout ~isRec:false moduleBinding cmtTbl 0 + printModuleBinding ~state ~isRec:false moduleBinding cmtTbl 0 | Pstr_recmodule moduleBindings -> printListi ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) ~nodes:moduleBindings - ~print:(printModuleBinding ~customLayout ~isRec:true) + ~print:(printModuleBinding ~state ~isRec:true) cmtTbl | Pstr_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl - | Pstr_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl + | Pstr_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil -and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = +and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = let prefix = Doc.text "type " in let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams ~customLayout te.ptyext_params cmtTbl in + let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in let extensionConstructors = let ecs = te.ptyext_constructors in let forceBreak = @@ -53726,7 +53734,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = let rows = printListi ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:(printExtensionConstructor ~customLayout) + ~print:(printExtensionConstructor ~state) ~nodes:ecs ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak @@ -53744,8 +53752,8 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout ~loc:te.ptyext_path.loc - te.ptyext_attributes cmtTbl; + printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmtTbl; prefix; name; typeParams; @@ -53753,7 +53761,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = extensionConstructors; ]) -and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = +and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = let prefix = if i = 0 then Doc.concat @@ -53763,9 +53771,9 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let modExprDoc, modConstraintDoc = match moduleBinding.pmb_expr with | {pmod_desc = Pmod_constraint (modExpr, modType)} -> - ( printModExpr ~customLayout modExpr cmtTbl, - Doc.concat [Doc.text ": "; printModType ~customLayout modType cmtTbl] ) - | modExpr -> (printModExpr ~customLayout modExpr cmtTbl, Doc.nil) + ( printModExpr ~state modExpr cmtTbl, + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] ) + | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil) in let modName = let doc = Doc.text moduleBinding.pmb_name.Location.txt in @@ -53774,7 +53782,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:moduleBinding.pmb_name.loc + printAttributes ~state ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes cmtTbl; prefix; modName; @@ -53785,7 +53793,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = in printComments doc cmtTbl moduleBinding.pmb_loc -and printModuleTypeDeclaration ~customLayout +and printModuleTypeDeclaration ~state (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = let modName = let doc = Doc.text modTypeDecl.pmtd_name.txt in @@ -53793,23 +53801,23 @@ and printModuleTypeDeclaration ~customLayout in Doc.concat [ - printAttributes ~customLayout modTypeDecl.pmtd_attributes cmtTbl; + printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; Doc.text "module type "; modName; (match modTypeDecl.pmtd_type with | None -> Doc.nil | Some modType -> - Doc.concat [Doc.text " = "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); ] -and printModType ~customLayout modType cmtTbl = +and printModType ~state modType cmtTbl = let modTypeDoc = match modType.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~customLayout ~loc:longident.loc - modType.pmty_attributes cmtTbl; + printAttributes ~state ~loc:longident.loc modType.pmty_attributes + cmtTbl; printLongidentLocation longident cmtTbl; ] | Pmty_signature [] -> @@ -53830,17 +53838,13 @@ and printModType ~customLayout modType cmtTbl = [ Doc.lbrace; Doc.indent - (Doc.concat - [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [ - printAttributes ~customLayout modType.pmty_attributes cmtTbl; - signatureDoc; - ] + [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] | Pmty_functor _ -> let parameters, returnType = ParsetreeViewer.functorType modType in let parametersDoc = @@ -53850,10 +53854,8 @@ and printModType ~customLayout modType cmtTbl = let cmtLoc = {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in - let doc = - Doc.concat [attrs; printModType ~customLayout modType cmtTbl] - in + let attrs = printAttributes ~state attrs cmtTbl in + let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in printComments doc cmtTbl cmtLoc | params -> Doc.group @@ -53879,7 +53881,7 @@ and printModType ~customLayout modType cmtTbl = } in let attrs = - printAttributes ~customLayout attrs cmtTbl + printAttributes ~state attrs cmtTbl in let lblDoc = if lbl.Location.txt = "_" || lbl.txt = "*" then @@ -53900,8 +53902,7 @@ and printModType ~customLayout modType cmtTbl = [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - printModType ~customLayout modType - cmtTbl; + printModType ~state modType cmtTbl; ]); ] in @@ -53914,7 +53915,7 @@ and printModType ~customLayout modType cmtTbl = ]) in let returnDoc = - let doc = printModType ~customLayout returnType cmtTbl in + let doc = printModType ~state returnType cmtTbl in if Parens.modTypeFunctorReturn returnType then addParens doc else doc in Doc.group @@ -53925,14 +53926,14 @@ and printModType ~customLayout modType cmtTbl = ]) | Pmty_typeof modExpr -> Doc.concat - [Doc.text "module type of "; printModExpr ~customLayout modExpr cmtTbl] + [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] | Pmty_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmty_alias longident -> Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] | Pmty_with (modType, withConstraints) -> let operand = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modTypeWithOperand modType then addParens doc else doc in Doc.group @@ -53941,10 +53942,7 @@ and printModType ~customLayout modType cmtTbl = operand; Doc.indent (Doc.concat - [ - Doc.line; - printWithConstraints ~customLayout withConstraints cmtTbl; - ]); + [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); ]) in let attrsAlreadyPrinted = @@ -53956,13 +53954,13 @@ and printModType ~customLayout modType cmtTbl = Doc.concat [ (if attrsAlreadyPrinted then Doc.nil - else printAttributes ~customLayout modType.pmty_attributes cmtTbl); + else printAttributes ~state modType.pmty_attributes cmtTbl); modTypeDoc; ] in printComments doc cmtTbl modType.pmty_loc -and printWithConstraints ~customLayout withConstraints cmtTbl = +and printWithConstraints ~state withConstraints cmtTbl = let rows = List.mapi (fun i withConstraint -> @@ -53970,19 +53968,19 @@ and printWithConstraints ~customLayout withConstraints cmtTbl = (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - printWithConstraint ~customLayout withConstraint cmtTbl; + printWithConstraint ~state withConstraint cmtTbl; ])) withConstraints in Doc.join ~sep:Doc.line rows -and printWithConstraint ~customLayout - (withConstraint : Parsetree.with_constraint) cmtTbl = +and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) + cmtTbl = match withConstraint with (* with type X.t = ... *) | Pwith_type (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) (* with module X.Y = Z *) @@ -53997,7 +53995,7 @@ and printWithConstraint ~customLayout (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_typesubst (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> @@ -54009,60 +54007,58 @@ and printWithConstraint ~customLayout Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] -and printSignature ~customLayout signature cmtTbl = +and printSignature ~state signature cmtTbl = match signature with | [] -> printCommentsInsideFile cmtTbl | signature -> printList ~getLoc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(printSignatureItem ~customLayout) + ~print:(printSignatureItem ~state) cmtTbl -and printSignatureItem ~customLayout (si : Parsetree.signature_item) cmtTbl = +and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = match si.psig_desc with | Parsetree.Psig_value valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Psig_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl - | Psig_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Psig_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Psig_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl | Psig_module moduleDeclaration -> - printModuleDeclaration ~customLayout moduleDeclaration cmtTbl + printModuleDeclaration ~state moduleDeclaration cmtTbl | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl + printRecModuleDeclarations ~state moduleDeclarations cmtTbl | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Psig_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Psig_include includeDescription -> - printIncludeDescription ~customLayout includeDescription cmtTbl + printIncludeDescription ~state includeDescription cmtTbl | Psig_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl = +and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.pmd_loc) ~nodes:moduleDeclarations - ~print:(printRecModuleDeclaration ~customLayout) + ~print:(printRecModuleDeclaration ~state) cmtTbl -and printRecModuleDeclaration ~customLayout md cmtTbl i = +and printRecModuleDeclaration ~state md cmtTbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> @@ -54074,7 +54070,7 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = | _ -> false in let modTypeDoc = - let doc = printModType ~customLayout md.pmd_type cmtTbl in + let doc = printModType ~state md.pmd_type cmtTbl in if needsParens then addParens doc else doc in Doc.concat [Doc.text ": "; modTypeDoc] @@ -54082,34 +54078,32 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text prefix; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printModuleDeclaration ~customLayout (md : Parsetree.module_declaration) - cmtTbl = +and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> - Doc.concat [Doc.text ": "; printModType ~customLayout md.pmd_type cmtTbl] + | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text "module "; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printOpenDescription ~customLayout - (openDescription : Parsetree.open_description) cmtTbl = +and printOpenDescription ~state (openDescription : Parsetree.open_description) + cmtTbl = Doc.concat [ - printAttributes ~customLayout openDescription.popen_attributes cmtTbl; + printAttributes ~state openDescription.popen_attributes cmtTbl; Doc.text "open"; (match openDescription.popen_override with | Asttypes.Fresh -> Doc.space @@ -54117,45 +54111,45 @@ and printOpenDescription ~customLayout printLongidentLocation openDescription.popen_lid cmtTbl; ] -and printIncludeDescription ~customLayout +and printIncludeDescription ~state (includeDescription : Parsetree.include_description) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDescription.pincl_attributes cmtTbl; + printAttributes ~state includeDescription.pincl_attributes cmtTbl; Doc.text "include "; - printModType ~customLayout includeDescription.pincl_mod cmtTbl; + printModType ~state includeDescription.pincl_mod cmtTbl; ] -and printIncludeDeclaration ~customLayout +and printIncludeDeclaration ~state (includeDeclaration : Parsetree.include_declaration) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDeclaration.pincl_attributes cmtTbl; + printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; Doc.text "include "; (let includeDoc = - printModExpr ~customLayout includeDeclaration.pincl_mod cmtTbl + printModExpr ~state includeDeclaration.pincl_mod cmtTbl in if Parens.includeModExpr includeDeclaration.pincl_mod then addParens includeDoc else includeDoc); ] -and printValueBindings ~customLayout ~recFlag - (vbs : Parsetree.value_binding list) cmtTbl = +and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) + cmtTbl = printListi ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~customLayout ~recFlag) + ~print:(printValueBinding ~state ~recFlag) cmtTbl -and printValueDescription ~customLayout valueDescription cmtTbl = +and printValueDescription ~state valueDescription cmtTbl = let isExternal = match valueDescription.pval_prim with | [] -> false | _ -> true in let attrs = - printAttributes ~customLayout ~loc:valueDescription.pval_name.loc + printAttributes ~state ~loc:valueDescription.pval_name.loc valueDescription.pval_attributes cmtTbl in let header = if isExternal then "external " else "let " in @@ -54168,7 +54162,7 @@ and printValueDescription ~customLayout valueDescription cmtTbl = (printIdentLike valueDescription.pval_name.txt) cmtTbl valueDescription.pval_name.loc; Doc.text ": "; - printTypExpr ~customLayout valueDescription.pval_type cmtTbl; + printTypExpr ~state valueDescription.pval_type cmtTbl; (if isExternal then Doc.group (Doc.concat @@ -54189,11 +54183,11 @@ and printValueDescription ~customLayout valueDescription cmtTbl = else Doc.nil); ]) -and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = +and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.ptype_loc) ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~customLayout ~recFlag) + ~print:(printTypeDeclaration2 ~state ~recFlag) cmtTbl (* @@ -54228,16 +54222,16 @@ and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i +and printTypeDeclaration ~state ~name ~equalSign ~recFlag i (td : Parsetree.type_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -54248,7 +54242,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -54265,7 +54259,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -54273,7 +54267,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -54283,39 +54277,37 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDeclaration2 ~customLayout ~recFlag - (td : Parsetree.type_declaration) cmtTbl i = +and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) + cmtTbl i = let name = let doc = printIdentLike td.Parsetree.ptype_name.txt in printComments doc cmtTbl td.ptype_name.loc in let equalSign = "=" in let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -54326,7 +54318,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -54354,7 +54346,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -54362,7 +54354,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -54372,25 +54364,23 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDefinitionConstraints ~customLayout cstrs = +and printTypeDefinitionConstraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -54401,20 +54391,18 @@ and printTypeDefinitionConstraints ~customLayout cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map - (printTypeDefinitionConstraint ~customLayout) - cstrs)); + (List.map (printTypeDefinitionConstraint ~state) cstrs)); ])) -and printTypeDefinitionConstraint ~customLayout +and printTypeDefinitionConstraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr ~customLayout typ1 CommentTable.empty; + printTypExpr ~state typ1 CommentTable.empty; Doc.text " = "; - printTypExpr ~customLayout typ2 CommentTable.empty; + printTypExpr ~state typ2 CommentTable.empty; ] and printPrivateFlag (flag : Asttypes.private_flag) = @@ -54422,7 +54410,7 @@ and printPrivateFlag (flag : Asttypes.private_flag) = | Private -> Doc.text "private " | Public -> Doc.nil -and printTypeParams ~customLayout typeParams cmtTbl = +and printTypeParams ~state typeParams cmtTbl = match typeParams with | [] -> Doc.nil | typeParams -> @@ -54438,9 +54426,7 @@ and printTypeParams ~customLayout typeParams cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun typeParam -> - let doc = - printTypeParam ~customLayout typeParam cmtTbl - in + let doc = printTypeParam ~state typeParam cmtTbl in printComments doc cmtTbl (fst typeParam).Parsetree.ptyp_loc) typeParams); @@ -54450,8 +54436,8 @@ and printTypeParams ~customLayout typeParams cmtTbl = Doc.greaterThan; ]) -and printTypeParam ~customLayout - (param : Parsetree.core_type * Asttypes.variance) cmtTbl = +and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) + cmtTbl = let typ, variance = param in let printedVariance = match variance with @@ -54459,10 +54445,10 @@ and printTypeParam ~customLayout | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printedVariance; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] -and printRecordDeclaration ~customLayout - (lds : Parsetree.label_declaration list) cmtTbl = +and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) + cmtTbl = let forceBreak = match (lds, List.rev lds) with | first :: _, last :: _ -> @@ -54481,9 +54467,7 @@ and printRecordDeclaration ~customLayout ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -54492,7 +54476,7 @@ and printRecordDeclaration ~customLayout Doc.rbrace; ]) -and printConstructorDeclarations ~customLayout ~privateFlag +and printConstructorDeclarations ~state ~privateFlag (cds : Parsetree.constructor_declaration list) cmtTbl = let forceBreak = match (cds, List.rev cds) with @@ -54510,16 +54494,16 @@ and printConstructorDeclarations ~customLayout ~privateFlag ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds ~print:(fun cd cmtTbl i -> - let doc = printConstructorDeclaration2 ~customLayout i cd cmtTbl in + let doc = printConstructorDeclaration2 ~state i cd cmtTbl in printComments doc cmtTbl cd.Parsetree.pcd_loc) ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak (Doc.indent (Doc.concat [Doc.line; privateFlag; rows])) -and printConstructorDeclaration2 ~customLayout i +and printConstructorDeclaration2 ~state i (cd : Parsetree.constructor_declaration) cmtTbl = - let attrs = printAttributes ~customLayout cd.pcd_attributes cmtTbl in + let attrs = printAttributes ~state cd.pcd_attributes cmtTbl in let bar = if i > 0 || cd.pcd_attributes <> [] then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil @@ -54529,14 +54513,13 @@ and printConstructorDeclaration2 ~customLayout i printComments doc cmtTbl cd.pcd_name.loc in let constrArgs = - printConstructorArguments ~customLayout ~indent:true cd.pcd_args cmtTbl + printConstructorArguments ~state ~indent:true cd.pcd_args cmtTbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent - (Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl]) + Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) in Doc.concat [ @@ -54552,7 +54535,7 @@ and printConstructorDeclaration2 ~customLayout i ]); ] -and printConstructorArguments ~customLayout ~indent +and printConstructorArguments ~state ~indent (cdArgs : Parsetree.constructor_arguments) cmtTbl = match cdArgs with | Pcstr_tuple [] -> Doc.nil @@ -54568,7 +54551,7 @@ and printConstructorArguments ~customLayout ~indent Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -54592,9 +54575,7 @@ and printConstructorArguments ~customLayout ~indent ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -54606,10 +54587,9 @@ and printConstructorArguments ~customLayout ~indent in if indent then Doc.indent args else args -and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) - cmtTbl = +and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl + printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl in let mutableFlag = match ld.pld_mutable with @@ -54629,10 +54609,10 @@ and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) name; optional; Doc.text ": "; - printTypExpr ~customLayout ld.pld_type cmtTbl; + printTypExpr ~state ld.pld_type cmtTbl; ]) -and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = +and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = @@ -54648,7 +54628,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | _ -> false in let returnDoc = - let doc = printTypExpr ~customLayout returnType cmtTbl in + let doc = printTypExpr ~state returnType cmtTbl in if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in @@ -54658,11 +54638,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl + printAttributes ~state ~inline:true attrsBefore cmtTbl else Doc.nil in let typDoc = - let doc = printTypExpr ~customLayout n cmtTbl in + let doc = printTypExpr ~state n cmtTbl in match n.ptyp_desc with | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc | _ -> doc @@ -54685,9 +54665,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = else Doc.concat [typDoc; Doc.text " => "; returnDoc]); ]) | args -> - let attrs = - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl - in + let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in let renderedArgs = Doc.concat [ @@ -54702,7 +54680,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun tp -> printTypeParameter ~customLayout tp cmtTbl) + (fun tp -> printTypeParameter ~state tp cmtTbl) args); ]); Doc.trailingComma; @@ -54718,7 +54696,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_var var -> Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] | Ptyp_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Ptyp_alias (typ, alias) -> let typ = (* Technically type t = (string, float) => unit as 'x, doesn't require @@ -54730,14 +54708,14 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] (* object printings *) | Ptyp_object (fields, openFlag) -> - printObject ~customLayout ~inline:false fields openFlag cmtTbl + printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in @@ -54757,7 +54735,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printObject ~customLayout ~inline:true fields openFlag cmtTbl; + printObject ~state ~inline:true fields openFlag cmtTbl; Doc.greaterThan; ] | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> @@ -54767,7 +54745,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printTupleType ~customLayout ~inline:true tuple cmtTbl; + printTupleType ~state ~inline:true tuple cmtTbl; Doc.greaterThan; ]) | Ptyp_constr (longidentLoc, constrArgs) -> ( @@ -54787,17 +54765,15 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> - printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) constrArgs); ]); Doc.trailingComma; Doc.softLine; Doc.greaterThan; ])) - | Ptyp_tuple types -> - printTupleType ~customLayout ~inline:false types cmtTbl - | Ptyp_poly ([], typ) -> printTypExpr ~customLayout typ cmtTbl + | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl + | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl | Ptyp_poly (stringLocs, typ) -> Doc.concat [ @@ -54809,11 +54785,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = stringLocs); Doc.dot; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | Ptyp_package packageType -> - printPackageType ~customLayout ~printModuleKeywordAndParens:true - packageType cmtTbl + printPackageType ~state ~printModuleKeywordAndParens:true packageType + cmtTbl | Ptyp_class _ -> Doc.text "classes are not supported in types" | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> let forceBreak = @@ -54826,7 +54802,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; ]) in @@ -54834,10 +54810,9 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Rtag ({txt}, attrs, truth, types) -> let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr ~customLayout t cmtTbl + | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl | _ -> - Doc.concat - [Doc.lparen; printTypExpr ~customLayout t cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] in let printedTypes = List.map doType types in let cases = @@ -54849,11 +54824,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; cases; ]) - | Rinherit coreType -> printTypExpr ~customLayout coreType cmtTbl + | Rinherit coreType -> printTypExpr ~state coreType cmtTbl in let docs = List.map printRowField rowFields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in @@ -54899,13 +54874,12 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let doc = match typExpr.ptyp_attributes with | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; renderedType]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) | _ -> renderedType in printComments doc cmtTbl typExpr.ptyp_loc -and printObject ~customLayout ~inline fields openFlag cmtTbl = +and printObject ~state ~inline fields openFlag cmtTbl = let doc = match fields with | [] -> @@ -54936,7 +54910,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> printObjectField ~customLayout field cmtTbl) + (fun field -> printObjectField ~state field cmtTbl) fields); ]); Doc.trailingComma; @@ -54946,8 +54920,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = in if inline then doc else Doc.group doc -and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) - cmtTbl = +and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = let tuple = Doc.concat [ @@ -54959,7 +54932,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -54969,7 +54942,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) in if inline == false then Doc.group tuple else tuple -and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = +and printObjectField ~state (field : Parsetree.object_field) cmtTbl = match field with | Otag (labelLoc, attrs, typ) -> let lbl = @@ -54979,27 +54952,27 @@ and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:labelLoc.loc attrs cmtTbl; + printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in printComments doc cmtTbl cmtLoc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; printTypExpr ~customLayout typexpr cmtTbl] + Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = +and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with | Asttypes.Nolabel -> Doc.nil @@ -55027,17 +55000,15 @@ and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = uncurried; attrs; label; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; optionalIndicator; ]) in printComments doc cmtTbl loc -and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) - cmtTbl i = +and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = let attrs = - printAttributes ~customLayout ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes - cmtTbl + printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl in let header = if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " @@ -55071,7 +55042,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -55079,13 +55050,10 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ]) | _ -> @@ -55098,7 +55066,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -55106,25 +55074,22 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout patTyp cmtTbl; + printTypExpr ~state patTyp cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ])) | _ -> let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in let printedExpr = - let doc = printExpressionWithComments ~customLayout vb.pvb_expr cmtTbl in + let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in match Parens.expr vb.pvb_expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let patternDoc = printPattern ~customLayout vb.pvb_pat cmtTbl in + let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -55186,7 +55151,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) else Doc.concat [Doc.space; printedExpr]); ]) -and printPackageType ~customLayout ~printModuleKeywordAndParens +and printPackageType ~state ~printModuleKeywordAndParens (packageType : Parsetree.package_type) cmtTbl = let doc = match packageType with @@ -55197,7 +55162,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens (Doc.concat [ printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints ~customLayout packageConstraints cmtTbl; + printPackageConstraints ~state packageConstraints cmtTbl; Doc.softLine; ]) in @@ -55205,7 +55170,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and printPackageConstraints ~customLayout packageConstraints cmtTbl = +and printPackageConstraints ~state packageConstraints cmtTbl = Doc.concat [ Doc.text " with"; @@ -55223,25 +55188,23 @@ and printPackageConstraints ~customLayout packageConstraints cmtTbl = loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = - printPackageConstraint ~customLayout i cmtTbl pc - in + let doc = printPackageConstraint ~state i cmtTbl pc in printComments doc cmtTbl cmtLoc) packageConstraints); ]); ] -and printPackageConstraint ~customLayout i cmtTbl (longidentLoc, typ) = +and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; printLongidentLocation longidentLoc cmtTbl; Doc.text " = "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] -and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = +and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = let txt = convertBsExtension stringLoc.Location.txt in let extName = let doc = @@ -55254,9 +55217,9 @@ and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = in printComments doc cmtTbl stringLoc.Location.loc in - Doc.group (Doc.concat [extName; printPayload ~customLayout payload cmtTbl]) + Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) -and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = +and printPattern ~state (p : Parsetree.pattern) cmtTbl = let patternWithoutAttributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" @@ -55278,7 +55241,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55300,7 +55263,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55329,15 +55292,12 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = (if shouldHug then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) - patterns); + (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat - [Doc.text "..."; printPattern ~customLayout tail cmtTbl] + Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] in let tail = printComments doc cmtTbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); @@ -55373,8 +55333,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -55386,7 +55345,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55394,7 +55353,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -55425,8 +55384,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -55438,7 +55396,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55446,7 +55404,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -55477,8 +55435,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printPatternRecordRow ~customLayout row cmtTbl) + (fun row -> printPatternRecordRow ~state row cmtTbl) rows); (match openFlag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] @@ -55495,7 +55452,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.group (Doc.concat [Doc.text "exception"; Doc.line; pat]) @@ -55505,7 +55462,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = let docs = List.mapi (fun i pat -> - let patternDoc = printPattern ~customLayout pat cmtTbl in + let patternDoc = printPattern ~state pat cmtTbl in Doc.concat [ (if i == 0 then Doc.nil @@ -55524,8 +55481,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) - | Ppat_extension ext -> - printExtension ~customLayout ~atModuleLvl:false ext cmtTbl + | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> let needsParens = match p.ppat_desc with @@ -55533,7 +55489,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] @@ -55544,7 +55500,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let renderedPattern = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat @@ -55560,7 +55516,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.text ": "; printComments - (printPackageType ~customLayout ~printModuleKeywordAndParens:false + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; Doc.rparen; @@ -55568,9 +55524,9 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) @@ -55591,13 +55547,11 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | attrs -> Doc.group (Doc.concat - [ - printAttributes ~customLayout attrs cmtTbl; patternWithoutAttributes; - ]) + [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) in printComments doc cmtTbl p.ppat_loc -and printPatternRecordRow ~customLayout row cmtTbl = +and printPatternRecordRow ~state row cmtTbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -55606,7 +55560,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = Doc.concat [ printOptionalLabel ppat_attributes; - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; printLidentPath longident cmtTbl; ] | longident, pattern -> @@ -55614,7 +55568,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in let rhsDoc = - let doc = printPattern ~customLayout pattern cmtTbl in + let doc = printPattern ~state pattern cmtTbl in let doc = if Parens.patternRecordRowRhs pattern then addParens doc else doc in @@ -55633,11 +55587,11 @@ and printPatternRecordRow ~customLayout row cmtTbl = in printComments doc cmtTbl locForComments -and printExpressionWithComments ~customLayout expr cmtTbl : Doc.t = - let doc = printExpression ~customLayout expr cmtTbl in +and printExpressionWithComments ~state expr cmtTbl : Doc.t = + let doc = printExpression ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc -and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = +and printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = let ifDocs = Doc.join ~sep:Doc.space (List.mapi @@ -55648,11 +55602,9 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | ParsetreeViewer.If ifExpr -> let condition = if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~customLayout ~braces:true ifExpr cmtTbl + printExpressionBlock ~state ~braces:true ifExpr cmtTbl else - let doc = - printExpressionWithComments ~customLayout ifExpr cmtTbl - in + let doc = printExpressionWithComments ~state ifExpr cmtTbl in match Parens.expr ifExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc ifExpr braces @@ -55669,14 +55621,12 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some _, expr -> expr | _ -> thenExpr in - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl); + printExpressionBlock ~state ~braces:true thenExpr cmtTbl); ] | IfLet (pattern, conditionExpr) -> let conditionDoc = let doc = - printExpressionWithComments ~customLayout conditionExpr - cmtTbl + printExpressionWithComments ~state conditionExpr cmtTbl in match Parens.expr conditionExpr with | Parens.Parenthesized -> addParens doc @@ -55687,12 +55637,11 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = [ ifTxt; Doc.text "let "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " = "; conditionDoc; Doc.space; - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl; + printExpressionBlock ~state ~braces:true thenExpr cmtTbl; ] in printLeadingComments doc cmtTbl.leading outerLoc) @@ -55704,14 +55653,13 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some expr -> Doc.concat [ - Doc.text " else "; - printExpressionBlock ~customLayout ~braces:true expr cmtTbl; + Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; ] in let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] -and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = +and printExpression ~state (e : Parsetree.expression) cmtTbl = let printArrow ~isUncurried e = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = @@ -55735,8 +55683,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | None -> false in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl + printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async + ~hasConstraint parameters cmtTbl in let returnExprDoc = let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in @@ -55758,7 +55706,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | _ -> true in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -55774,13 +55722,13 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match typConstraint with | Some typ -> let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if Parens.arrowReturnTypExpr typ then addParens doc else doc in Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in Doc.group (Doc.concat [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) @@ -55790,7 +55738,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Parsetree.Pexp_constant c -> printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment ~customLayout e cmtTbl + printJsxFragment ~state e cmtTbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat @@ -55805,9 +55753,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -55828,8 +55774,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55855,7 +55800,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -55875,8 +55820,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55890,7 +55834,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -55927,8 +55871,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55957,8 +55900,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55983,7 +55925,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -56003,8 +55945,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -56018,7 +55959,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -56046,7 +55987,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout + printExpressionWithComments ~state (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e @@ -56066,9 +56007,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56104,7 +56043,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - printExpressionRecordRow ~customLayout row cmtTbl + printExpressionRecordRow ~state row cmtTbl punningAllowed) rows); ]); @@ -56140,31 +56079,29 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printBsObjectRow ~customLayout row cmtTbl) + (fun row -> printBsObjectRow ~state row cmtTbl) rows); ]); Doc.trailingComma; Doc.softLine; Doc.rbrace; ]) - | extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl) + | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl) | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) when ParsetreeViewer.isSpreadBeltListConcat e -> - printBeltListConcatApply ~customLayout subLists cmtTbl + printBeltListConcatApply ~state subLists cmtTbl | Pexp_apply _ -> if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression ~customLayout e cmtTbl + printUnaryExpression ~state e cmtTbl else if ParsetreeViewer.isTemplateLiteral e then - printTemplateLiteral ~customLayout e cmtTbl + printTemplateLiteral ~state e cmtTbl else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression ~customLayout e cmtTbl - else printPexpApply ~customLayout e cmtTbl + printBinaryExpression ~state e cmtTbl + else printPexpApply ~state e cmtTbl | Pexp_unreachable -> Doc.dot | Pexp_field (expr, longidentLoc) -> let lhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.fieldExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56172,7 +56109,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [lhs; Doc.dot; printLidentPath longidentLoc cmtTbl] | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr ~customLayout e.pexp_attributes expr1 longidentLoc expr2 + printSetFieldExpr ~state e.pexp_attributes expr1 longidentLoc expr2 e.pexp_loc cmtTbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) when ParsetreeViewer.isTernaryExpr e -> @@ -56183,7 +56120,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printTernaryOperand ~customLayout condition1 cmtTbl; + printTernaryOperand ~state condition1 cmtTbl; Doc.indent (Doc.concat [ @@ -56192,8 +56129,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.text "? "; - printTernaryOperand ~customLayout consequent1 - cmtTbl; + printTernaryOperand ~state consequent1 cmtTbl; ]); Doc.concat (List.map @@ -56202,18 +56138,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = [ Doc.line; Doc.text ": "; - printTernaryOperand ~customLayout condition - cmtTbl; + printTernaryOperand ~state condition cmtTbl; Doc.line; Doc.text "? "; - printTernaryOperand ~customLayout consequent - cmtTbl; + printTernaryOperand ~state consequent cmtTbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent - (printTernaryOperand ~customLayout alternate cmtTbl); + Doc.indent (printTernaryOperand ~state alternate cmtTbl); ]); ]) | _ -> Doc.nil @@ -56226,15 +56159,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens ternaryDoc else ternaryDoc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments ~customLayout expr1 cmtTbl in + let doc = printExpressionWithComments ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -56247,32 +56180,28 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (if ParsetreeViewer.isBlockExpr expr1 then condition else Doc.group (Doc.ifBreaks (addParens condition) condition)); Doc.space; - printExpressionBlock ~customLayout ~braces:true expr2 cmtTbl; + printExpressionBlock ~state ~braces:true expr2 cmtTbl; ]) | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "for "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " in "; - (let doc = - printExpressionWithComments ~customLayout fromExpr cmtTbl - in + (let doc = printExpressionWithComments ~state fromExpr cmtTbl in match Parens.expr fromExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc fromExpr braces | Nothing -> doc); printDirectionFlag directionFlag; - (let doc = - printExpressionWithComments ~customLayout toExpr cmtTbl - in + (let doc = printExpressionWithComments ~state toExpr cmtTbl in match Parens.expr toExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc toExpr braces | Nothing -> doc); Doc.space; - printExpressionBlock ~customLayout ~braces:true body cmtTbl; + printExpressionBlock ~state ~braces:true body cmtTbl; ]) | Pexp_constraint ( {pexp_desc = Pexp_pack modExpr}, @@ -56285,10 +56214,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.softLine; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; printComments - (printPackageType ~customLayout + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; ]); @@ -56297,20 +56226,20 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ]) | Pexp_constraint (expr, typ) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_assert expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56319,7 +56248,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [Doc.text "assert "; rhs] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56327,24 +56256,22 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_pack modExpr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat - [Doc.softLine; printModExpr ~customLayout modExpr cmtTbl]); + (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); Doc.softLine; Doc.rparen; ]) - | Pexp_sequence _ -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl + | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_try (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56355,43 +56282,37 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text "try "; exprDoc; Doc.text " catch "; - printCases ~customLayout cases cmtTbl; + printCases ~state cases cmtTbl; ] | Pexp_match (_, [_; _]) when ParsetreeViewer.isIfLetExpr e -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_match (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat - [ - Doc.text "switch "; - exprDoc; - Doc.space; - printCases ~customLayout cases cmtTbl; - ] + [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] | Pexp_function cases -> - Doc.concat - [Doc.text "x => switch x "; printCases ~customLayout cases cmtTbl] + Doc.concat [Doc.text "x => switch x "; printCases ~state cases cmtTbl] | Pexp_coerce (expr, typOpt, typ) -> - let docExpr = printExpressionWithComments ~customLayout expr cmtTbl in - let docTyp = printTypExpr ~customLayout typ cmtTbl in + let docExpr = printExpressionWithComments ~state expr cmtTbl in + let docTyp = printTypExpr ~state typ cmtTbl in let ofType = match typOpt with | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ1 cmtTbl] + Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] in Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] | Pexp_send (parentExpr, label) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -56443,11 +56364,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match e.pexp_attributes with | [] -> exprWithAwait | attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprWithAwait]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) | _ -> exprWithAwait -and printPexpFun ~customLayout ~inCallback e cmtTbl = +and printPexpFun ~state ~inCallback e cmtTbl = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = ParsetreeViewer.processFunctionAttributes attrsOnArrow @@ -56464,7 +56384,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> (returnExpr, None) in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback ~async ~uncurried + printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint: (match typConstraint with | Some _ -> true @@ -56491,7 +56411,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> false in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -56512,36 +56432,35 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = in let typConstraintDoc = match typConstraint with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | _ -> Doc.nil in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc; ] -and printTernaryOperand ~customLayout expr cmtTbl = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in +and printTernaryOperand ~state expr cmtTbl = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.ternaryOperand expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc -and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = +and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl = let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.setFieldExprRhs rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces | Nothing -> doc in let lhsDoc = - let doc = printExpressionWithComments ~customLayout lhs cmtTbl in + let doc = printExpressionWithComments ~state lhs cmtTbl in match Parens.fieldExpr lhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc lhs braces @@ -56564,12 +56483,11 @@ and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = let doc = match attrs with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in printComments doc cmtTbl loc -and printTemplateLiteral ~customLayout expr cmtTbl = +and printTemplateLiteral ~state expr cmtTbl = let tag = ref "js" in let rec walkExpr expr = let open Parsetree in @@ -56584,7 +56502,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = tag := prefix; printStringContents txt | _ -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in let content = walkExpr expr in @@ -56596,7 +56514,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = Doc.text "`"; ] -and printUnaryExpression ~customLayout expr cmtTbl = +and printUnaryExpression ~state expr cmtTbl = let printUnaryOperator op = Doc.text (match op with @@ -56612,7 +56530,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> let printedOperand = - let doc = printExpressionWithComments ~customLayout operand cmtTbl in + let doc = printExpressionWithComments ~state operand cmtTbl in match Parens.unaryExprOperand operand with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc operand braces @@ -56622,7 +56540,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = printComments doc cmtTbl expr.pexp_loc | _ -> assert false -and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = +and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with @@ -56669,7 +56587,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = right.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {right with pexp_attributes = rightInternalAttrs} cmtTbl in @@ -56680,10 +56598,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = in let doc = Doc.concat - [ - printAttributes ~customLayout rightPrinteableAttrs cmtTbl; - doc; - ] + [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] in match rightPrinteableAttrs with | [] -> doc @@ -56728,7 +56643,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {expr with pexp_attributes = internalAttrs} cmtTbl in @@ -56741,8 +56656,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat - [printAttributes ~customLayout printeableAttrs cmtTbl; doc] + Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -56750,19 +56664,19 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = printTemplateLiteral ~customLayout expr cmtTbl in + let doc = printTemplateLiteral ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - printSetFieldExpr ~customLayout expr.pexp_attributes lhs field rhs + printSetFieldExpr ~state expr.pexp_attributes lhs field rhs expr.pexp_loc cmtTbl in if isLhs then addParens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments ~customLayout rhs cmtTbl in - let lhsDoc = printExpressionWithComments ~customLayout lhs cmtTbl in + let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in + let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in (* TODO: unify indentation of "=" *) let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = @@ -56780,12 +56694,11 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in if isLhs then addParens doc else doc | _ -> ( - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.binaryExprOperand ~isLhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56800,15 +56713,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = when not (ParsetreeViewer.isBinaryExpression lhs || ParsetreeViewer.isBinaryExpression rhs - || printAttributes ~customLayout expr.pexp_attributes cmtTbl - <> Doc.nil) -> + || printAttributes ~state expr.pexp_attributes cmtTbl <> Doc.nil) -> let lhsHasCommentBelow = hasCommentBelow cmtTbl lhs.pexp_loc in let lhsDoc = printOperand ~isLhs:true lhs op in let rhsDoc = printOperand ~isLhs:false rhs op in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] @@ -56842,7 +56754,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; (match Parens.binaryExpr { @@ -56858,14 +56770,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ]) | _ -> Doc.nil -and printBeltListConcatApply ~customLayout subLists cmtTbl = +and printBeltListConcatApply ~state subLists cmtTbl = let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ commaBeforeSpread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56886,9 +56798,7 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56916,13 +56826,13 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ]) (* callExpr(arg1, arg2) *) -and printPexpApply ~customLayout expr cmtTbl = +and printPexpApply ~state expr cmtTbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -56933,14 +56843,14 @@ and printPexpApply ~customLayout expr cmtTbl = match memberExpr.pexp_desc with | Pexp_ident lident -> printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments ~customLayout memberExpr cmtTbl + | _ -> printExpressionWithComments ~state memberExpr cmtTbl in Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -56950,7 +56860,7 @@ and printPexpApply ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.expr rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces @@ -56965,7 +56875,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printExpressionWithComments ~customLayout lhs cmtTbl; + printExpressionWithComments ~state lhs cmtTbl; Doc.text " ="; (if shouldIndent then Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) @@ -56974,8 +56884,8 @@ and printPexpApply ~customLayout expr cmtTbl = in match expr.pexp_attributes with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc])) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) @@ -56983,7 +56893,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -57000,7 +56910,7 @@ and printPexpApply ~customLayout expr cmtTbl = [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -57009,7 +56919,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -57021,7 +56931,7 @@ and printPexpApply ~customLayout expr cmtTbl = -> let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -57055,14 +56965,14 @@ and printPexpApply ~customLayout expr cmtTbl = || ParsetreeViewer.isArrayAccess e in let targetExpr = - let doc = printExpressionWithComments ~customLayout targetExpr cmtTbl in + let doc = printExpressionWithComments ~state targetExpr cmtTbl in match Parens.expr targetExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc targetExpr braces | Nothing -> doc in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -57071,7 +56981,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -57084,7 +56994,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression ~customLayout lident args cmtTbl + printJsxExpression ~state lident args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map @@ -57095,7 +57005,7 @@ and printPexpApply ~customLayout expr cmtTbl = ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes in let callExprDoc = - let doc = printExpressionWithComments ~customLayout callExpr cmtTbl in + let doc = printExpressionWithComments ~state callExpr cmtTbl in match Parens.callExpr callExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc callExpr braces @@ -57103,15 +57013,12 @@ and printPexpApply ~customLayout expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57133,19 +57040,18 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.concat [ maybeBreakParent; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc; ] else - let argsDoc = printArguments ~customLayout ~uncurried args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + let argsDoc = printArguments ~state ~uncurried args cmtTbl in + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false -and printJsxExpression ~customLayout lident args cmtTbl = +and printJsxExpression ~state lident args cmtTbl = let name = printJsxName lident in - let formattedProps, children = printJsxProps ~customLayout args cmtTbl in + let formattedProps, children = printJsxProps ~state args cmtTbl in (*
*) let hasChildren = match children with @@ -57184,8 +57090,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = Doc.line; (match children with | Some childrenExpression -> - printJsxChildren ~customLayout childrenExpression ~sep:lineSep - cmtTbl + printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl | None -> Doc.nil); ]); lineSep; @@ -57241,7 +57146,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = ]); ]) -and printJsxFragment ~customLayout expr cmtTbl = +and printJsxFragment ~state expr cmtTbl = let opening = Doc.text "<>" in let closing = Doc.text "" in let lineSep = @@ -57256,16 +57161,12 @@ and printJsxFragment ~customLayout expr cmtTbl = | _ -> Doc.indent (Doc.concat - [ - Doc.line; - printJsxChildren ~customLayout expr ~sep:lineSep cmtTbl; - ])); + [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); lineSep; closing; ]) -and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep - cmtTbl = +and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = match childrenExpr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in @@ -57276,9 +57177,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let addParensOrBraces exprDoc = (* {(20: int)} make sure that we also protect the expression inside *) let innerDoc = @@ -57297,9 +57196,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout childrenExpr cmtTbl - in + let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in Doc.concat [ Doc.dotdotdot; @@ -57314,8 +57211,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep | Nothing -> exprDoc); ] -and printJsxProps ~customLayout args cmtTbl : - Doc.t * Parsetree.expression option = +and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = (* This function was introduced because we have different formatting behavior for self-closing tags and other tags we always put /> on a new line for self-closing tag when it breaks expr.pexp_loc in let trailingCommentsPresent = hasTrailingComments cmtTbl loc in - let propDoc = printJsxProp ~customLayout lastProp cmtTbl in + let propDoc = printJsxProp ~state lastProp cmtTbl in let formattedProps = Doc.concat [ @@ -57387,12 +57283,12 @@ and printJsxProps ~customLayout args cmtTbl : in (formattedProps, Some children) | arg :: args -> - let propDoc = printJsxProp ~customLayout arg cmtTbl in + let propDoc = printJsxProp ~state arg cmtTbl in loop (propDoc :: props) args in loop [] args -and printJsxProp ~customLayout arg cmtTbl = +and printJsxProp ~state arg cmtTbl = match arg with | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { @@ -57418,7 +57314,7 @@ and printJsxProp ~customLayout arg cmtTbl = | Labelled _lbl -> printIdentLike ident | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; Doc.softLine; doc; Doc.rbrace] | lbl, expr -> let argLoc, expr = @@ -57441,7 +57337,7 @@ and printJsxProp ~customLayout arg cmtTbl = let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.jsxPropExpr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) @@ -57471,12 +57367,11 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = State.nextCustomLayout state in let cmtTblCopy = CommentTable.copy cmtTbl in let callback, printedArgs = match args with @@ -57491,17 +57386,14 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args in let callback = Doc.concat - [ - lblDoc; - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl; - ] + [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] in let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in let printedArgs = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~customLayout arg cmtTbl) args)) + (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) in (callback, printedArgs) | _ -> assert false @@ -57532,9 +57424,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * arg3, * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57551,16 +57441,15 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = state |> State.nextCustomLayout in let cmtTblCopy = CommentTable.copy cmtTbl in let cmtTblCopy2 = CommentTable.copy cmtTbl in let rec loop acc args = @@ -57578,7 +57467,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl + printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl in let doc = Doc.concat [lblDoc; pexpFunDoc] in printComments doc cmtTbl expr.pexp_loc) @@ -57586,7 +57475,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackArgumentsFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:ArgumentsFitOnOneLine expr + printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr cmtTblCopy in let doc = Doc.concat [lblDoc; pexpFunDoc] in @@ -57596,7 +57485,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args callbackFitsOnOneLine, callbackArgumentsFitsOnOneLine ) | arg :: args -> - let argDoc = printArgument ~customLayout arg cmtTbl in + let argDoc = printArgument ~state arg cmtTbl in loop (Doc.line :: Doc.comma :: argDoc :: acc) args in let printedArgs, callback, callback2 = loop [] args in @@ -57635,9 +57524,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy2) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57654,7 +57541,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout @@ -57664,7 +57551,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args Lazy.force breakAllArgs; ] -and printArguments ~customLayout ~uncurried +and printArguments ~state ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -57683,7 +57570,7 @@ and printArguments ~customLayout ~uncurried | _ -> Doc.text "()") | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -57702,9 +57589,7 @@ and printArguments ~customLayout ~uncurried (if uncurried then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> printArgument ~customLayout arg cmtTbl) - args); + (List.map (fun arg -> printArgument ~state arg cmtTbl) args); ]); Doc.trailingComma; Doc.softLine; @@ -57725,7 +57610,7 @@ and printArguments ~customLayout ~uncurried * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and printArgument ~customLayout (argLbl, arg) cmtTbl = +and printArgument ~state (argLbl, arg) cmtTbl = match (argLbl, arg) with (* ~a (punned)*) | ( Asttypes.Labelled lbl, @@ -57765,7 +57650,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = Doc.tilde; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in printComments doc cmtTbl loc @@ -57803,7 +57688,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = printComments doc cmtTbl argLoc in let printedExpr = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -57813,7 +57698,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = let doc = Doc.concat [printedLbl; printedExpr] in printComments doc cmtTbl loc -and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = +and printCases ~state (cases : Parsetree.case list) cmtTbl = Doc.breakableGroup ~forceBreak:true (Doc.concat [ @@ -57827,22 +57712,22 @@ and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = n.Parsetree.pc_lhs.ppat_loc with loc_end = n.pc_rhs.pexp_loc.loc_end; }) - ~print:(printCase ~customLayout) ~nodes:cases cmtTbl; + ~print:(printCase ~state) ~nodes:cases cmtTbl; ]; Doc.line; Doc.rbrace; ]) -and printCase ~customLayout (case : Parsetree.case) cmtTbl = +and printCase ~state (case : Parsetree.case) cmtTbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~customLayout + printExpressionBlock ~state ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) case.pc_rhs cmtTbl | _ -> ( - let doc = printExpressionWithComments ~customLayout case.pc_rhs cmtTbl in + let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in match Parens.expr case.pc_rhs with | Parenthesized -> addParens doc | _ -> doc) @@ -57857,7 +57742,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ]) in let shouldInlineRhs = @@ -57874,7 +57759,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = | _ -> true in let patternDoc = - let doc = printPattern ~customLayout case.pc_lhs cmtTbl in + let doc = printPattern ~state case.pc_lhs cmtTbl in match case.pc_lhs.ppat_desc with | Ppat_constraint _ -> addParens doc | _ -> doc @@ -57891,8 +57776,8 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = in Doc.group (Doc.concat [Doc.text "| "; content]) -and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried - ~hasConstraint parameters cmtTbl = +and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint + parameters cmtTbl = match parameters with (* let f = _ => () *) | [ @@ -57931,7 +57816,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried match attrs with | [] -> if hasConstraint then addParens var else var | attrs -> - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in addParens (Doc.concat [attrs; var]) in if async then addAsync var else var @@ -57973,7 +57858,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> printExpFunParameter ~customLayout p cmtTbl) + (fun p -> printExpFunParameter ~state p cmtTbl) parameters); ] in @@ -57988,13 +57873,13 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.rparen; ]) -and printExpFunParameter ~customLayout parameter cmtTbl = +and printExpFunParameter ~state parameter cmtTbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.text "type "; Doc.join ~sep:Doc.space (List.map @@ -58009,27 +57894,27 @@ and printExpFunParameter ~customLayout parameter cmtTbl = let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = match defaultExpr with | Some expr -> Doc.concat - [Doc.text "="; printExpressionWithComments ~customLayout expr cmtTbl] + [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) let labelWithPattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> printPattern ~customLayout pattern cmtTbl + | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl | ( (Asttypes.Labelled lbl | Optional lbl), {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) when lbl = stringLoc.txt -> (* ~d *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; ] @@ -58042,11 +57927,11 @@ and printExpFunParameter ~customLayout parameter cmtTbl = (* ~d: e *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) @@ -58055,7 +57940,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = Doc.text "~"; printIdentLike lbl; Doc.text " as "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; ] in let optionalLabelSuffix = @@ -58095,7 +57980,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = in printComments doc cmtTbl cmtLoc -and printExpressionBlock ~customLayout ~braces expr cmtTbl = +and printExpressionBlock ~state ~braces expr cmtTbl = let rec collectRows acc expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> @@ -58109,7 +57994,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = Doc.text "module "; name; Doc.text " = "; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; ] in let loc = {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} in @@ -58126,7 +58011,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = {cmtLoc with loc_end = loc.loc_end} in let letExceptionDoc = - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl in collectRows ((loc, letExceptionDoc) :: acc) expr2 | Pexp_open (overrideFlag, longidentLoc, expr2) -> @@ -58143,7 +58028,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = collectRows ((loc, openDoc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> let exprDoc = - let doc = printExpression ~customLayout expr1 cmtTbl in + let doc = printExpression ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -58170,9 +58055,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl - in + let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in (* let () = { * let () = foo() * () @@ -58185,7 +58068,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | _ -> collectRows ((loc, letDoc) :: acc) expr2) | _ -> let exprDoc = - let doc = printExpression ~customLayout expr cmtTbl in + let doc = printExpression ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58262,7 +58145,7 @@ and printDirectionFlag flag = | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = +and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group @@ -58272,7 +58155,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = (* print punned field *) Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; printOptionalLabel expr.pexp_attributes; printLidentPath lbl cmtTbl; ] @@ -58282,7 +58165,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = printLidentPath lbl cmtTbl; Doc.text ": "; printOptionalLabel expr.pexp_attributes; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.exprRecordRowRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58291,7 +58174,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = in printComments doc cmtTbl cmtLoc -and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = +and printBsObjectRow ~state (lbl, expr) cmtTbl = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let lblDoc = let doc = @@ -58304,7 +58187,7 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = [ lblDoc; Doc.text ": "; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58319,8 +58202,8 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and printAttributes ?loc ?(inline = false) ~customLayout - (attrs : Parsetree.attributes) cmtTbl = +and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmtTbl = match ParsetreeViewer.filterParsingAttrs attrs with | [] -> Doc.nil | attrs -> @@ -58338,17 +58221,15 @@ and printAttributes ?loc ?(inline = false) ~customLayout [ Doc.group (Doc.joinWithSep - (List.map - (fun attr -> printAttribute ~customLayout attr cmtTbl) - attrs)); + (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); (if inline then Doc.space else lineBreak); ] -and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = +and printPayload ~state (payload : Parsetree.payload) cmtTbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments ~customLayout expr cmtTbl in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let needsParens = match attrs with | [] -> false @@ -58359,7 +58240,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.concat [ Doc.lparen; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); Doc.rparen; ] @@ -58371,22 +58252,21 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = (Doc.concat [ Doc.softLine; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); ]); Doc.softLine; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - addParens (printStructureItem ~customLayout si cmtTbl) - | PStr structure -> addParens (printStructure ~customLayout structure cmtTbl) + addParens (printStructureItem ~state si cmtTbl) + | PStr structure -> addParens (printStructure ~state structure cmtTbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent - (Doc.concat [Doc.line; printTypExpr ~customLayout typ cmtTbl]); + Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); Doc.softLine; Doc.rparen; ] @@ -58398,7 +58278,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ] | None -> Doc.nil in @@ -58410,7 +58290,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.softLine; Doc.text "? "; - printPattern ~customLayout pat cmtTbl; + printPattern ~state pat cmtTbl; whenDoc; ]); Doc.softLine; @@ -58422,12 +58302,12 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.softLine; Doc.rparen; ] -and printAttribute ?(standalone = false) ~customLayout +and printAttribute ?(standalone = false) ~state ((id, payload) : Parsetree.attribute) cmtTbl = match (id, payload) with | ( {txt = "ns.doc"}, @@ -58451,11 +58331,11 @@ and printAttribute ?(standalone = false) ~customLayout [ Doc.text (if standalone then "@@" else "@"); Doc.text (convertBsExternalAttribute id.txt); - printPayload ~customLayout payload cmtTbl; + printPayload ~state payload cmtTbl; ]), Doc.line ) -and printModExpr ~customLayout modExpr cmtTbl = +and printModExpr ~state modExpr cmtTbl = let doc = match modExpr.pmod_desc with | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl @@ -58473,7 +58353,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.lbrace; Doc.indent (Doc.concat - [Doc.softLine; printStructure ~customLayout structure cmtTbl]); + [Doc.softLine; printStructure ~state structure cmtTbl]); Doc.softLine; Doc.rbrace; ]) @@ -58493,7 +58373,7 @@ and printModExpr ~customLayout modExpr cmtTbl = (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> let packageDoc = let doc = - printPackageType ~customLayout ~printModuleKeywordAndParens:false + printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl in printComments doc cmtTbl ptyp_loc @@ -58509,10 +58389,7 @@ and printModExpr ~customLayout modExpr cmtTbl = let unpackDoc = Doc.group (Doc.concat - [ - printExpressionWithComments ~customLayout expr cmtTbl; - moduleConstraint; - ]) + [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) in Doc.group (Doc.concat @@ -58528,7 +58405,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.rparen; ]) | Pmod_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmod_apply _ -> let args, callExpr = ParsetreeViewer.modExprApply modExpr in let isUnitSugar = @@ -58544,17 +58421,15 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.group (Doc.concat [ - printModExpr ~customLayout callExpr cmtTbl; + printModExpr ~state callExpr cmtTbl; (if isUnitSugar then - printModApplyArg ~customLayout - (List.hd args [@doesNotRaise]) - cmtTbl + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else Doc.concat [ Doc.lparen; (if shouldHug then - printModApplyArg ~customLayout + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else @@ -58566,7 +58441,7 @@ and printModExpr ~customLayout modExpr cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun modArg -> - printModApplyArg ~customLayout modArg cmtTbl) + printModApplyArg ~state modArg cmtTbl) args); ])); (if not shouldHug then @@ -58578,15 +58453,15 @@ and printModExpr ~customLayout modExpr cmtTbl = | Pmod_constraint (modExpr, modType) -> Doc.concat [ - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - printModType ~customLayout modType cmtTbl; + printModType ~state modType cmtTbl; ] - | Pmod_functor _ -> printModFunctor ~customLayout modExpr cmtTbl + | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl in printComments doc cmtTbl modExpr.pmod_loc -and printModFunctor ~customLayout modExpr cmtTbl = +and printModFunctor ~state modExpr cmtTbl = let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) @@ -58597,18 +58472,18 @@ and printModFunctor ~customLayout modExpr cmtTbl = match returnModExpr.pmod_desc with | Pmod_constraint (modExpr, modType) -> let constraintDoc = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modExprFunctorConstraint modType then addParens doc else doc in let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in - (modConstraint, printModExpr ~customLayout modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr ~customLayout returnModExpr cmtTbl) + (modConstraint, printModExpr ~state modExpr cmtTbl) + | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) in let parametersDoc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; Doc.text "()"]) + (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -58622,8 +58497,7 @@ and printModFunctor ~customLayout modExpr cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> - printModFunctorParam ~customLayout param cmtTbl) + (fun param -> printModFunctorParam ~state param cmtTbl) parameters); ]); Doc.trailingComma; @@ -58635,14 +58509,14 @@ and printModFunctor ~customLayout modExpr cmtTbl = (Doc.concat [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) -and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = +and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = let cmtLoc = match optModType with | None -> lbl.Asttypes.loc | Some modType -> {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let lblDoc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in printComments doc cmtTbl lbl.loc @@ -58656,19 +58530,17 @@ and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = (match optModType with | None -> Doc.nil | Some modType -> - Doc.concat - [Doc.text ": "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); ]) in printComments doc cmtTbl cmtLoc -and printModApplyArg ~customLayout modExpr cmtTbl = +and printModApplyArg ~state modExpr cmtTbl = match modExpr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr ~customLayout modExpr cmtTbl + | _ -> printModExpr ~state modExpr cmtTbl -and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) - cmtTbl = +and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = let kind = match constr.pext_kind with | Pext_rebind longident -> @@ -58679,15 +58551,11 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc @@ -58696,7 +58564,7 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) Doc.group (Doc.concat [ - printAttributes ~customLayout constr.pext_attributes cmtTbl; + printAttributes ~state constr.pext_attributes cmtTbl; Doc.text "exception "; name; kind; @@ -58704,9 +58572,9 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) in printComments doc cmtTbl constr.pext_loc -and printExtensionConstructor ~customLayout - (constr : Parsetree.extension_constructor) cmtTbl i = - let attrs = printAttributes ~customLayout constr.pext_attributes cmtTbl in +and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) + cmtTbl i = + let attrs = printAttributes ~state constr.pext_attributes cmtTbl in let bar = if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil in @@ -58720,40 +58588,36 @@ and printExtensionConstructor ~customLayout | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -let printTypeParams = printTypeParams ~customLayout:0 -let printTypExpr = printTypExpr ~customLayout:0 -let printExpression = printExpression ~customLayout:0 -let printPattern = printPattern ~customLayout:0 +let printTypeParams = printTypeParams ~state:State.init +let printTypExpr = printTypExpr ~state:State.init +let printExpression = printExpression ~state:State.init +let printPattern = printPattern ~state:State.init let printImplementation ~width (s : Parsetree.structure) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkStructure s cmtTbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure ~customLayout:0 s cmtTbl in + let doc = printStructure ~state:State.init s cmtTbl in (* Doc.debug doc; *) Doc.toString ~width doc ^ "\n" let printInterface ~width (s : Parsetree.signature) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkSignature s cmtTbl comments; - Doc.toString ~width (printSignature ~customLayout:0 s cmtTbl) ^ "\n" + Doc.toString ~width (printSignature ~state:State.init s cmtTbl) ^ "\n" -let printStructure = printStructure ~customLayout:0 +let printStructure = printStructure ~state:State.init end module Pattern_printer : sig diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 33aa370387..904e0dd4b2 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -53637,19 +53637,29 @@ let printOptionalLabel attrs = if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" else Doc.nil -let customLayoutThreshold = 2 +module State = struct + let customLayoutThreshold = 2 -let rec printStructure ~customLayout (s : Parsetree.structure) t = + type t = {customLayout: int; uncurried: bool} + + let init = {customLayout = 0; uncurried = false} + + let nextCustomLayout t = {t with customLayout = t.customLayout + 1} + + let shouldBreakCallback t = t.customLayout > customLayoutThreshold +end + +let rec printStructure ~state (s : Parsetree.structure) t = match s with | [] -> printCommentsInsideFile t | structure -> printList ~getLoc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(printStructureItem ~customLayout) + ~print:(printStructureItem ~state) t -and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = +and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = match si.pstr_desc with | Pstr_value (rec_flag, valueBindings) -> let recFlag = @@ -53657,58 +53667,56 @@ and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl + printValueBindings ~state ~recFlag valueBindings cmtTbl | Pstr_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl | Pstr_primitive valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Pstr_eval (expr, attrs) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.structureExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] | Pstr_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Pstr_include includeDeclaration -> - printIncludeDeclaration ~customLayout includeDeclaration cmtTbl + printIncludeDeclaration ~state includeDeclaration cmtTbl | Pstr_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Pstr_module moduleBinding -> - printModuleBinding ~customLayout ~isRec:false moduleBinding cmtTbl 0 + printModuleBinding ~state ~isRec:false moduleBinding cmtTbl 0 | Pstr_recmodule moduleBindings -> printListi ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) ~nodes:moduleBindings - ~print:(printModuleBinding ~customLayout ~isRec:true) + ~print:(printModuleBinding ~state ~isRec:true) cmtTbl | Pstr_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl - | Pstr_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl + | Pstr_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil -and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = +and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = let prefix = Doc.text "type " in let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams ~customLayout te.ptyext_params cmtTbl in + let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in let extensionConstructors = let ecs = te.ptyext_constructors in let forceBreak = @@ -53726,7 +53734,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = let rows = printListi ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:(printExtensionConstructor ~customLayout) + ~print:(printExtensionConstructor ~state) ~nodes:ecs ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak @@ -53744,8 +53752,8 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout ~loc:te.ptyext_path.loc - te.ptyext_attributes cmtTbl; + printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmtTbl; prefix; name; typeParams; @@ -53753,7 +53761,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = extensionConstructors; ]) -and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = +and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = let prefix = if i = 0 then Doc.concat @@ -53763,9 +53771,9 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let modExprDoc, modConstraintDoc = match moduleBinding.pmb_expr with | {pmod_desc = Pmod_constraint (modExpr, modType)} -> - ( printModExpr ~customLayout modExpr cmtTbl, - Doc.concat [Doc.text ": "; printModType ~customLayout modType cmtTbl] ) - | modExpr -> (printModExpr ~customLayout modExpr cmtTbl, Doc.nil) + ( printModExpr ~state modExpr cmtTbl, + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] ) + | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil) in let modName = let doc = Doc.text moduleBinding.pmb_name.Location.txt in @@ -53774,7 +53782,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:moduleBinding.pmb_name.loc + printAttributes ~state ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes cmtTbl; prefix; modName; @@ -53785,7 +53793,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = in printComments doc cmtTbl moduleBinding.pmb_loc -and printModuleTypeDeclaration ~customLayout +and printModuleTypeDeclaration ~state (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = let modName = let doc = Doc.text modTypeDecl.pmtd_name.txt in @@ -53793,23 +53801,23 @@ and printModuleTypeDeclaration ~customLayout in Doc.concat [ - printAttributes ~customLayout modTypeDecl.pmtd_attributes cmtTbl; + printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; Doc.text "module type "; modName; (match modTypeDecl.pmtd_type with | None -> Doc.nil | Some modType -> - Doc.concat [Doc.text " = "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); ] -and printModType ~customLayout modType cmtTbl = +and printModType ~state modType cmtTbl = let modTypeDoc = match modType.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~customLayout ~loc:longident.loc - modType.pmty_attributes cmtTbl; + printAttributes ~state ~loc:longident.loc modType.pmty_attributes + cmtTbl; printLongidentLocation longident cmtTbl; ] | Pmty_signature [] -> @@ -53830,17 +53838,13 @@ and printModType ~customLayout modType cmtTbl = [ Doc.lbrace; Doc.indent - (Doc.concat - [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [ - printAttributes ~customLayout modType.pmty_attributes cmtTbl; - signatureDoc; - ] + [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] | Pmty_functor _ -> let parameters, returnType = ParsetreeViewer.functorType modType in let parametersDoc = @@ -53850,10 +53854,8 @@ and printModType ~customLayout modType cmtTbl = let cmtLoc = {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in - let doc = - Doc.concat [attrs; printModType ~customLayout modType cmtTbl] - in + let attrs = printAttributes ~state attrs cmtTbl in + let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in printComments doc cmtTbl cmtLoc | params -> Doc.group @@ -53879,7 +53881,7 @@ and printModType ~customLayout modType cmtTbl = } in let attrs = - printAttributes ~customLayout attrs cmtTbl + printAttributes ~state attrs cmtTbl in let lblDoc = if lbl.Location.txt = "_" || lbl.txt = "*" then @@ -53900,8 +53902,7 @@ and printModType ~customLayout modType cmtTbl = [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - printModType ~customLayout modType - cmtTbl; + printModType ~state modType cmtTbl; ]); ] in @@ -53914,7 +53915,7 @@ and printModType ~customLayout modType cmtTbl = ]) in let returnDoc = - let doc = printModType ~customLayout returnType cmtTbl in + let doc = printModType ~state returnType cmtTbl in if Parens.modTypeFunctorReturn returnType then addParens doc else doc in Doc.group @@ -53925,14 +53926,14 @@ and printModType ~customLayout modType cmtTbl = ]) | Pmty_typeof modExpr -> Doc.concat - [Doc.text "module type of "; printModExpr ~customLayout modExpr cmtTbl] + [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] | Pmty_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmty_alias longident -> Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] | Pmty_with (modType, withConstraints) -> let operand = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modTypeWithOperand modType then addParens doc else doc in Doc.group @@ -53941,10 +53942,7 @@ and printModType ~customLayout modType cmtTbl = operand; Doc.indent (Doc.concat - [ - Doc.line; - printWithConstraints ~customLayout withConstraints cmtTbl; - ]); + [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); ]) in let attrsAlreadyPrinted = @@ -53956,13 +53954,13 @@ and printModType ~customLayout modType cmtTbl = Doc.concat [ (if attrsAlreadyPrinted then Doc.nil - else printAttributes ~customLayout modType.pmty_attributes cmtTbl); + else printAttributes ~state modType.pmty_attributes cmtTbl); modTypeDoc; ] in printComments doc cmtTbl modType.pmty_loc -and printWithConstraints ~customLayout withConstraints cmtTbl = +and printWithConstraints ~state withConstraints cmtTbl = let rows = List.mapi (fun i withConstraint -> @@ -53970,19 +53968,19 @@ and printWithConstraints ~customLayout withConstraints cmtTbl = (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - printWithConstraint ~customLayout withConstraint cmtTbl; + printWithConstraint ~state withConstraint cmtTbl; ])) withConstraints in Doc.join ~sep:Doc.line rows -and printWithConstraint ~customLayout - (withConstraint : Parsetree.with_constraint) cmtTbl = +and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) + cmtTbl = match withConstraint with (* with type X.t = ... *) | Pwith_type (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) (* with module X.Y = Z *) @@ -53997,7 +53995,7 @@ and printWithConstraint ~customLayout (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_typesubst (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> @@ -54009,60 +54007,58 @@ and printWithConstraint ~customLayout Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] -and printSignature ~customLayout signature cmtTbl = +and printSignature ~state signature cmtTbl = match signature with | [] -> printCommentsInsideFile cmtTbl | signature -> printList ~getLoc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(printSignatureItem ~customLayout) + ~print:(printSignatureItem ~state) cmtTbl -and printSignatureItem ~customLayout (si : Parsetree.signature_item) cmtTbl = +and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = match si.psig_desc with | Parsetree.Psig_value valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Psig_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl - | Psig_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Psig_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Psig_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl | Psig_module moduleDeclaration -> - printModuleDeclaration ~customLayout moduleDeclaration cmtTbl + printModuleDeclaration ~state moduleDeclaration cmtTbl | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl + printRecModuleDeclarations ~state moduleDeclarations cmtTbl | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Psig_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Psig_include includeDescription -> - printIncludeDescription ~customLayout includeDescription cmtTbl + printIncludeDescription ~state includeDescription cmtTbl | Psig_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl = +and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.pmd_loc) ~nodes:moduleDeclarations - ~print:(printRecModuleDeclaration ~customLayout) + ~print:(printRecModuleDeclaration ~state) cmtTbl -and printRecModuleDeclaration ~customLayout md cmtTbl i = +and printRecModuleDeclaration ~state md cmtTbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> @@ -54074,7 +54070,7 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = | _ -> false in let modTypeDoc = - let doc = printModType ~customLayout md.pmd_type cmtTbl in + let doc = printModType ~state md.pmd_type cmtTbl in if needsParens then addParens doc else doc in Doc.concat [Doc.text ": "; modTypeDoc] @@ -54082,34 +54078,32 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text prefix; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printModuleDeclaration ~customLayout (md : Parsetree.module_declaration) - cmtTbl = +and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> - Doc.concat [Doc.text ": "; printModType ~customLayout md.pmd_type cmtTbl] + | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text "module "; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printOpenDescription ~customLayout - (openDescription : Parsetree.open_description) cmtTbl = +and printOpenDescription ~state (openDescription : Parsetree.open_description) + cmtTbl = Doc.concat [ - printAttributes ~customLayout openDescription.popen_attributes cmtTbl; + printAttributes ~state openDescription.popen_attributes cmtTbl; Doc.text "open"; (match openDescription.popen_override with | Asttypes.Fresh -> Doc.space @@ -54117,45 +54111,45 @@ and printOpenDescription ~customLayout printLongidentLocation openDescription.popen_lid cmtTbl; ] -and printIncludeDescription ~customLayout +and printIncludeDescription ~state (includeDescription : Parsetree.include_description) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDescription.pincl_attributes cmtTbl; + printAttributes ~state includeDescription.pincl_attributes cmtTbl; Doc.text "include "; - printModType ~customLayout includeDescription.pincl_mod cmtTbl; + printModType ~state includeDescription.pincl_mod cmtTbl; ] -and printIncludeDeclaration ~customLayout +and printIncludeDeclaration ~state (includeDeclaration : Parsetree.include_declaration) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDeclaration.pincl_attributes cmtTbl; + printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; Doc.text "include "; (let includeDoc = - printModExpr ~customLayout includeDeclaration.pincl_mod cmtTbl + printModExpr ~state includeDeclaration.pincl_mod cmtTbl in if Parens.includeModExpr includeDeclaration.pincl_mod then addParens includeDoc else includeDoc); ] -and printValueBindings ~customLayout ~recFlag - (vbs : Parsetree.value_binding list) cmtTbl = +and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) + cmtTbl = printListi ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~customLayout ~recFlag) + ~print:(printValueBinding ~state ~recFlag) cmtTbl -and printValueDescription ~customLayout valueDescription cmtTbl = +and printValueDescription ~state valueDescription cmtTbl = let isExternal = match valueDescription.pval_prim with | [] -> false | _ -> true in let attrs = - printAttributes ~customLayout ~loc:valueDescription.pval_name.loc + printAttributes ~state ~loc:valueDescription.pval_name.loc valueDescription.pval_attributes cmtTbl in let header = if isExternal then "external " else "let " in @@ -54168,7 +54162,7 @@ and printValueDescription ~customLayout valueDescription cmtTbl = (printIdentLike valueDescription.pval_name.txt) cmtTbl valueDescription.pval_name.loc; Doc.text ": "; - printTypExpr ~customLayout valueDescription.pval_type cmtTbl; + printTypExpr ~state valueDescription.pval_type cmtTbl; (if isExternal then Doc.group (Doc.concat @@ -54189,11 +54183,11 @@ and printValueDescription ~customLayout valueDescription cmtTbl = else Doc.nil); ]) -and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = +and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.ptype_loc) ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~customLayout ~recFlag) + ~print:(printTypeDeclaration2 ~state ~recFlag) cmtTbl (* @@ -54228,16 +54222,16 @@ and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i +and printTypeDeclaration ~state ~name ~equalSign ~recFlag i (td : Parsetree.type_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -54248,7 +54242,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -54265,7 +54259,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -54273,7 +54267,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -54283,39 +54277,37 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDeclaration2 ~customLayout ~recFlag - (td : Parsetree.type_declaration) cmtTbl i = +and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) + cmtTbl i = let name = let doc = printIdentLike td.Parsetree.ptype_name.txt in printComments doc cmtTbl td.ptype_name.loc in let equalSign = "=" in let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -54326,7 +54318,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -54354,7 +54346,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -54362,7 +54354,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -54372,25 +54364,23 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDefinitionConstraints ~customLayout cstrs = +and printTypeDefinitionConstraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -54401,20 +54391,18 @@ and printTypeDefinitionConstraints ~customLayout cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map - (printTypeDefinitionConstraint ~customLayout) - cstrs)); + (List.map (printTypeDefinitionConstraint ~state) cstrs)); ])) -and printTypeDefinitionConstraint ~customLayout +and printTypeDefinitionConstraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr ~customLayout typ1 CommentTable.empty; + printTypExpr ~state typ1 CommentTable.empty; Doc.text " = "; - printTypExpr ~customLayout typ2 CommentTable.empty; + printTypExpr ~state typ2 CommentTable.empty; ] and printPrivateFlag (flag : Asttypes.private_flag) = @@ -54422,7 +54410,7 @@ and printPrivateFlag (flag : Asttypes.private_flag) = | Private -> Doc.text "private " | Public -> Doc.nil -and printTypeParams ~customLayout typeParams cmtTbl = +and printTypeParams ~state typeParams cmtTbl = match typeParams with | [] -> Doc.nil | typeParams -> @@ -54438,9 +54426,7 @@ and printTypeParams ~customLayout typeParams cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun typeParam -> - let doc = - printTypeParam ~customLayout typeParam cmtTbl - in + let doc = printTypeParam ~state typeParam cmtTbl in printComments doc cmtTbl (fst typeParam).Parsetree.ptyp_loc) typeParams); @@ -54450,8 +54436,8 @@ and printTypeParams ~customLayout typeParams cmtTbl = Doc.greaterThan; ]) -and printTypeParam ~customLayout - (param : Parsetree.core_type * Asttypes.variance) cmtTbl = +and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) + cmtTbl = let typ, variance = param in let printedVariance = match variance with @@ -54459,10 +54445,10 @@ and printTypeParam ~customLayout | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printedVariance; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] -and printRecordDeclaration ~customLayout - (lds : Parsetree.label_declaration list) cmtTbl = +and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) + cmtTbl = let forceBreak = match (lds, List.rev lds) with | first :: _, last :: _ -> @@ -54481,9 +54467,7 @@ and printRecordDeclaration ~customLayout ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -54492,7 +54476,7 @@ and printRecordDeclaration ~customLayout Doc.rbrace; ]) -and printConstructorDeclarations ~customLayout ~privateFlag +and printConstructorDeclarations ~state ~privateFlag (cds : Parsetree.constructor_declaration list) cmtTbl = let forceBreak = match (cds, List.rev cds) with @@ -54510,16 +54494,16 @@ and printConstructorDeclarations ~customLayout ~privateFlag ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds ~print:(fun cd cmtTbl i -> - let doc = printConstructorDeclaration2 ~customLayout i cd cmtTbl in + let doc = printConstructorDeclaration2 ~state i cd cmtTbl in printComments doc cmtTbl cd.Parsetree.pcd_loc) ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak (Doc.indent (Doc.concat [Doc.line; privateFlag; rows])) -and printConstructorDeclaration2 ~customLayout i +and printConstructorDeclaration2 ~state i (cd : Parsetree.constructor_declaration) cmtTbl = - let attrs = printAttributes ~customLayout cd.pcd_attributes cmtTbl in + let attrs = printAttributes ~state cd.pcd_attributes cmtTbl in let bar = if i > 0 || cd.pcd_attributes <> [] then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil @@ -54529,14 +54513,13 @@ and printConstructorDeclaration2 ~customLayout i printComments doc cmtTbl cd.pcd_name.loc in let constrArgs = - printConstructorArguments ~customLayout ~indent:true cd.pcd_args cmtTbl + printConstructorArguments ~state ~indent:true cd.pcd_args cmtTbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent - (Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl]) + Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) in Doc.concat [ @@ -54552,7 +54535,7 @@ and printConstructorDeclaration2 ~customLayout i ]); ] -and printConstructorArguments ~customLayout ~indent +and printConstructorArguments ~state ~indent (cdArgs : Parsetree.constructor_arguments) cmtTbl = match cdArgs with | Pcstr_tuple [] -> Doc.nil @@ -54568,7 +54551,7 @@ and printConstructorArguments ~customLayout ~indent Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -54592,9 +54575,7 @@ and printConstructorArguments ~customLayout ~indent ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -54606,10 +54587,9 @@ and printConstructorArguments ~customLayout ~indent in if indent then Doc.indent args else args -and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) - cmtTbl = +and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl + printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl in let mutableFlag = match ld.pld_mutable with @@ -54629,10 +54609,10 @@ and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) name; optional; Doc.text ": "; - printTypExpr ~customLayout ld.pld_type cmtTbl; + printTypExpr ~state ld.pld_type cmtTbl; ]) -and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = +and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = @@ -54648,7 +54628,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | _ -> false in let returnDoc = - let doc = printTypExpr ~customLayout returnType cmtTbl in + let doc = printTypExpr ~state returnType cmtTbl in if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in @@ -54658,11 +54638,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl + printAttributes ~state ~inline:true attrsBefore cmtTbl else Doc.nil in let typDoc = - let doc = printTypExpr ~customLayout n cmtTbl in + let doc = printTypExpr ~state n cmtTbl in match n.ptyp_desc with | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc | _ -> doc @@ -54685,9 +54665,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = else Doc.concat [typDoc; Doc.text " => "; returnDoc]); ]) | args -> - let attrs = - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl - in + let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in let renderedArgs = Doc.concat [ @@ -54702,7 +54680,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun tp -> printTypeParameter ~customLayout tp cmtTbl) + (fun tp -> printTypeParameter ~state tp cmtTbl) args); ]); Doc.trailingComma; @@ -54718,7 +54696,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_var var -> Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] | Ptyp_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Ptyp_alias (typ, alias) -> let typ = (* Technically type t = (string, float) => unit as 'x, doesn't require @@ -54730,14 +54708,14 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] (* object printings *) | Ptyp_object (fields, openFlag) -> - printObject ~customLayout ~inline:false fields openFlag cmtTbl + printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in @@ -54757,7 +54735,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printObject ~customLayout ~inline:true fields openFlag cmtTbl; + printObject ~state ~inline:true fields openFlag cmtTbl; Doc.greaterThan; ] | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> @@ -54767,7 +54745,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printTupleType ~customLayout ~inline:true tuple cmtTbl; + printTupleType ~state ~inline:true tuple cmtTbl; Doc.greaterThan; ]) | Ptyp_constr (longidentLoc, constrArgs) -> ( @@ -54787,17 +54765,15 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> - printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) constrArgs); ]); Doc.trailingComma; Doc.softLine; Doc.greaterThan; ])) - | Ptyp_tuple types -> - printTupleType ~customLayout ~inline:false types cmtTbl - | Ptyp_poly ([], typ) -> printTypExpr ~customLayout typ cmtTbl + | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl + | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl | Ptyp_poly (stringLocs, typ) -> Doc.concat [ @@ -54809,11 +54785,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = stringLocs); Doc.dot; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | Ptyp_package packageType -> - printPackageType ~customLayout ~printModuleKeywordAndParens:true - packageType cmtTbl + printPackageType ~state ~printModuleKeywordAndParens:true packageType + cmtTbl | Ptyp_class _ -> Doc.text "classes are not supported in types" | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> let forceBreak = @@ -54826,7 +54802,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; ]) in @@ -54834,10 +54810,9 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Rtag ({txt}, attrs, truth, types) -> let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr ~customLayout t cmtTbl + | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl | _ -> - Doc.concat - [Doc.lparen; printTypExpr ~customLayout t cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] in let printedTypes = List.map doType types in let cases = @@ -54849,11 +54824,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; cases; ]) - | Rinherit coreType -> printTypExpr ~customLayout coreType cmtTbl + | Rinherit coreType -> printTypExpr ~state coreType cmtTbl in let docs = List.map printRowField rowFields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in @@ -54899,13 +54874,12 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let doc = match typExpr.ptyp_attributes with | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; renderedType]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) | _ -> renderedType in printComments doc cmtTbl typExpr.ptyp_loc -and printObject ~customLayout ~inline fields openFlag cmtTbl = +and printObject ~state ~inline fields openFlag cmtTbl = let doc = match fields with | [] -> @@ -54936,7 +54910,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> printObjectField ~customLayout field cmtTbl) + (fun field -> printObjectField ~state field cmtTbl) fields); ]); Doc.trailingComma; @@ -54946,8 +54920,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = in if inline then doc else Doc.group doc -and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) - cmtTbl = +and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = let tuple = Doc.concat [ @@ -54959,7 +54932,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -54969,7 +54942,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) in if inline == false then Doc.group tuple else tuple -and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = +and printObjectField ~state (field : Parsetree.object_field) cmtTbl = match field with | Otag (labelLoc, attrs, typ) -> let lbl = @@ -54979,27 +54952,27 @@ and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:labelLoc.loc attrs cmtTbl; + printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in printComments doc cmtTbl cmtLoc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; printTypExpr ~customLayout typexpr cmtTbl] + Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = +and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with | Asttypes.Nolabel -> Doc.nil @@ -55027,17 +55000,15 @@ and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = uncurried; attrs; label; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; optionalIndicator; ]) in printComments doc cmtTbl loc -and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) - cmtTbl i = +and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = let attrs = - printAttributes ~customLayout ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes - cmtTbl + printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl in let header = if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " @@ -55071,7 +55042,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -55079,13 +55050,10 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ]) | _ -> @@ -55098,7 +55066,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -55106,25 +55074,22 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout patTyp cmtTbl; + printTypExpr ~state patTyp cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ])) | _ -> let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in let printedExpr = - let doc = printExpressionWithComments ~customLayout vb.pvb_expr cmtTbl in + let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in match Parens.expr vb.pvb_expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let patternDoc = printPattern ~customLayout vb.pvb_pat cmtTbl in + let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -55186,7 +55151,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) else Doc.concat [Doc.space; printedExpr]); ]) -and printPackageType ~customLayout ~printModuleKeywordAndParens +and printPackageType ~state ~printModuleKeywordAndParens (packageType : Parsetree.package_type) cmtTbl = let doc = match packageType with @@ -55197,7 +55162,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens (Doc.concat [ printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints ~customLayout packageConstraints cmtTbl; + printPackageConstraints ~state packageConstraints cmtTbl; Doc.softLine; ]) in @@ -55205,7 +55170,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and printPackageConstraints ~customLayout packageConstraints cmtTbl = +and printPackageConstraints ~state packageConstraints cmtTbl = Doc.concat [ Doc.text " with"; @@ -55223,25 +55188,23 @@ and printPackageConstraints ~customLayout packageConstraints cmtTbl = loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = - printPackageConstraint ~customLayout i cmtTbl pc - in + let doc = printPackageConstraint ~state i cmtTbl pc in printComments doc cmtTbl cmtLoc) packageConstraints); ]); ] -and printPackageConstraint ~customLayout i cmtTbl (longidentLoc, typ) = +and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; printLongidentLocation longidentLoc cmtTbl; Doc.text " = "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] -and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = +and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = let txt = convertBsExtension stringLoc.Location.txt in let extName = let doc = @@ -55254,9 +55217,9 @@ and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = in printComments doc cmtTbl stringLoc.Location.loc in - Doc.group (Doc.concat [extName; printPayload ~customLayout payload cmtTbl]) + Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) -and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = +and printPattern ~state (p : Parsetree.pattern) cmtTbl = let patternWithoutAttributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" @@ -55278,7 +55241,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55300,7 +55263,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55329,15 +55292,12 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = (if shouldHug then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) - patterns); + (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat - [Doc.text "..."; printPattern ~customLayout tail cmtTbl] + Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] in let tail = printComments doc cmtTbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); @@ -55373,8 +55333,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -55386,7 +55345,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55394,7 +55353,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -55425,8 +55384,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -55438,7 +55396,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -55446,7 +55404,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -55477,8 +55435,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printPatternRecordRow ~customLayout row cmtTbl) + (fun row -> printPatternRecordRow ~state row cmtTbl) rows); (match openFlag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] @@ -55495,7 +55452,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.group (Doc.concat [Doc.text "exception"; Doc.line; pat]) @@ -55505,7 +55462,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = let docs = List.mapi (fun i pat -> - let patternDoc = printPattern ~customLayout pat cmtTbl in + let patternDoc = printPattern ~state pat cmtTbl in Doc.concat [ (if i == 0 then Doc.nil @@ -55524,8 +55481,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) - | Ppat_extension ext -> - printExtension ~customLayout ~atModuleLvl:false ext cmtTbl + | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> let needsParens = match p.ppat_desc with @@ -55533,7 +55489,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] @@ -55544,7 +55500,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let renderedPattern = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat @@ -55560,7 +55516,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.text ": "; printComments - (printPackageType ~customLayout ~printModuleKeywordAndParens:false + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; Doc.rparen; @@ -55568,9 +55524,9 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) @@ -55591,13 +55547,11 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | attrs -> Doc.group (Doc.concat - [ - printAttributes ~customLayout attrs cmtTbl; patternWithoutAttributes; - ]) + [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) in printComments doc cmtTbl p.ppat_loc -and printPatternRecordRow ~customLayout row cmtTbl = +and printPatternRecordRow ~state row cmtTbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -55606,7 +55560,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = Doc.concat [ printOptionalLabel ppat_attributes; - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; printLidentPath longident cmtTbl; ] | longident, pattern -> @@ -55614,7 +55568,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in let rhsDoc = - let doc = printPattern ~customLayout pattern cmtTbl in + let doc = printPattern ~state pattern cmtTbl in let doc = if Parens.patternRecordRowRhs pattern then addParens doc else doc in @@ -55633,11 +55587,11 @@ and printPatternRecordRow ~customLayout row cmtTbl = in printComments doc cmtTbl locForComments -and printExpressionWithComments ~customLayout expr cmtTbl : Doc.t = - let doc = printExpression ~customLayout expr cmtTbl in +and printExpressionWithComments ~state expr cmtTbl : Doc.t = + let doc = printExpression ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc -and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = +and printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = let ifDocs = Doc.join ~sep:Doc.space (List.mapi @@ -55648,11 +55602,9 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | ParsetreeViewer.If ifExpr -> let condition = if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~customLayout ~braces:true ifExpr cmtTbl + printExpressionBlock ~state ~braces:true ifExpr cmtTbl else - let doc = - printExpressionWithComments ~customLayout ifExpr cmtTbl - in + let doc = printExpressionWithComments ~state ifExpr cmtTbl in match Parens.expr ifExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc ifExpr braces @@ -55669,14 +55621,12 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some _, expr -> expr | _ -> thenExpr in - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl); + printExpressionBlock ~state ~braces:true thenExpr cmtTbl); ] | IfLet (pattern, conditionExpr) -> let conditionDoc = let doc = - printExpressionWithComments ~customLayout conditionExpr - cmtTbl + printExpressionWithComments ~state conditionExpr cmtTbl in match Parens.expr conditionExpr with | Parens.Parenthesized -> addParens doc @@ -55687,12 +55637,11 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = [ ifTxt; Doc.text "let "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " = "; conditionDoc; Doc.space; - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl; + printExpressionBlock ~state ~braces:true thenExpr cmtTbl; ] in printLeadingComments doc cmtTbl.leading outerLoc) @@ -55704,14 +55653,13 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some expr -> Doc.concat [ - Doc.text " else "; - printExpressionBlock ~customLayout ~braces:true expr cmtTbl; + Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; ] in let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] -and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = +and printExpression ~state (e : Parsetree.expression) cmtTbl = let printArrow ~isUncurried e = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = @@ -55735,8 +55683,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | None -> false in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl + printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async + ~hasConstraint parameters cmtTbl in let returnExprDoc = let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in @@ -55758,7 +55706,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | _ -> true in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -55774,13 +55722,13 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match typConstraint with | Some typ -> let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if Parens.arrowReturnTypExpr typ then addParens doc else doc in Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in Doc.group (Doc.concat [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) @@ -55790,7 +55738,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Parsetree.Pexp_constant c -> printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment ~customLayout e cmtTbl + printJsxFragment ~state e cmtTbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat @@ -55805,9 +55753,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -55828,8 +55774,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55855,7 +55800,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -55875,8 +55820,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55890,7 +55834,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -55927,8 +55871,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55957,8 +55900,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -55983,7 +55925,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -56003,8 +55945,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -56018,7 +55959,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -56046,7 +55987,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout + printExpressionWithComments ~state (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e @@ -56066,9 +56007,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56104,7 +56043,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - printExpressionRecordRow ~customLayout row cmtTbl + printExpressionRecordRow ~state row cmtTbl punningAllowed) rows); ]); @@ -56140,31 +56079,29 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printBsObjectRow ~customLayout row cmtTbl) + (fun row -> printBsObjectRow ~state row cmtTbl) rows); ]); Doc.trailingComma; Doc.softLine; Doc.rbrace; ]) - | extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl) + | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl) | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) when ParsetreeViewer.isSpreadBeltListConcat e -> - printBeltListConcatApply ~customLayout subLists cmtTbl + printBeltListConcatApply ~state subLists cmtTbl | Pexp_apply _ -> if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression ~customLayout e cmtTbl + printUnaryExpression ~state e cmtTbl else if ParsetreeViewer.isTemplateLiteral e then - printTemplateLiteral ~customLayout e cmtTbl + printTemplateLiteral ~state e cmtTbl else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression ~customLayout e cmtTbl - else printPexpApply ~customLayout e cmtTbl + printBinaryExpression ~state e cmtTbl + else printPexpApply ~state e cmtTbl | Pexp_unreachable -> Doc.dot | Pexp_field (expr, longidentLoc) -> let lhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.fieldExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56172,7 +56109,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [lhs; Doc.dot; printLidentPath longidentLoc cmtTbl] | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr ~customLayout e.pexp_attributes expr1 longidentLoc expr2 + printSetFieldExpr ~state e.pexp_attributes expr1 longidentLoc expr2 e.pexp_loc cmtTbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) when ParsetreeViewer.isTernaryExpr e -> @@ -56183,7 +56120,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printTernaryOperand ~customLayout condition1 cmtTbl; + printTernaryOperand ~state condition1 cmtTbl; Doc.indent (Doc.concat [ @@ -56192,8 +56129,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.text "? "; - printTernaryOperand ~customLayout consequent1 - cmtTbl; + printTernaryOperand ~state consequent1 cmtTbl; ]); Doc.concat (List.map @@ -56202,18 +56138,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = [ Doc.line; Doc.text ": "; - printTernaryOperand ~customLayout condition - cmtTbl; + printTernaryOperand ~state condition cmtTbl; Doc.line; Doc.text "? "; - printTernaryOperand ~customLayout consequent - cmtTbl; + printTernaryOperand ~state consequent cmtTbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent - (printTernaryOperand ~customLayout alternate cmtTbl); + Doc.indent (printTernaryOperand ~state alternate cmtTbl); ]); ]) | _ -> Doc.nil @@ -56226,15 +56159,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens ternaryDoc else ternaryDoc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments ~customLayout expr1 cmtTbl in + let doc = printExpressionWithComments ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -56247,32 +56180,28 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (if ParsetreeViewer.isBlockExpr expr1 then condition else Doc.group (Doc.ifBreaks (addParens condition) condition)); Doc.space; - printExpressionBlock ~customLayout ~braces:true expr2 cmtTbl; + printExpressionBlock ~state ~braces:true expr2 cmtTbl; ]) | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "for "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " in "; - (let doc = - printExpressionWithComments ~customLayout fromExpr cmtTbl - in + (let doc = printExpressionWithComments ~state fromExpr cmtTbl in match Parens.expr fromExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc fromExpr braces | Nothing -> doc); printDirectionFlag directionFlag; - (let doc = - printExpressionWithComments ~customLayout toExpr cmtTbl - in + (let doc = printExpressionWithComments ~state toExpr cmtTbl in match Parens.expr toExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc toExpr braces | Nothing -> doc); Doc.space; - printExpressionBlock ~customLayout ~braces:true body cmtTbl; + printExpressionBlock ~state ~braces:true body cmtTbl; ]) | Pexp_constraint ( {pexp_desc = Pexp_pack modExpr}, @@ -56285,10 +56214,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.softLine; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; printComments - (printPackageType ~customLayout + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; ]); @@ -56297,20 +56226,20 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ]) | Pexp_constraint (expr, typ) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_assert expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56319,7 +56248,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [Doc.text "assert "; rhs] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56327,24 +56256,22 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_pack modExpr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat - [Doc.softLine; printModExpr ~customLayout modExpr cmtTbl]); + (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); Doc.softLine; Doc.rparen; ]) - | Pexp_sequence _ -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl + | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_try (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56355,43 +56282,37 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text "try "; exprDoc; Doc.text " catch "; - printCases ~customLayout cases cmtTbl; + printCases ~state cases cmtTbl; ] | Pexp_match (_, [_; _]) when ParsetreeViewer.isIfLetExpr e -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_match (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat - [ - Doc.text "switch "; - exprDoc; - Doc.space; - printCases ~customLayout cases cmtTbl; - ] + [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] | Pexp_function cases -> - Doc.concat - [Doc.text "x => switch x "; printCases ~customLayout cases cmtTbl] + Doc.concat [Doc.text "x => switch x "; printCases ~state cases cmtTbl] | Pexp_coerce (expr, typOpt, typ) -> - let docExpr = printExpressionWithComments ~customLayout expr cmtTbl in - let docTyp = printTypExpr ~customLayout typ cmtTbl in + let docExpr = printExpressionWithComments ~state expr cmtTbl in + let docTyp = printTypExpr ~state typ cmtTbl in let ofType = match typOpt with | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ1 cmtTbl] + Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] in Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] | Pexp_send (parentExpr, label) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -56443,11 +56364,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match e.pexp_attributes with | [] -> exprWithAwait | attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprWithAwait]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) | _ -> exprWithAwait -and printPexpFun ~customLayout ~inCallback e cmtTbl = +and printPexpFun ~state ~inCallback e cmtTbl = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = ParsetreeViewer.processFunctionAttributes attrsOnArrow @@ -56464,7 +56384,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> (returnExpr, None) in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback ~async ~uncurried + printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint: (match typConstraint with | Some _ -> true @@ -56491,7 +56411,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> false in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -56512,36 +56432,35 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = in let typConstraintDoc = match typConstraint with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | _ -> Doc.nil in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc; ] -and printTernaryOperand ~customLayout expr cmtTbl = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in +and printTernaryOperand ~state expr cmtTbl = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.ternaryOperand expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc -and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = +and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl = let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.setFieldExprRhs rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces | Nothing -> doc in let lhsDoc = - let doc = printExpressionWithComments ~customLayout lhs cmtTbl in + let doc = printExpressionWithComments ~state lhs cmtTbl in match Parens.fieldExpr lhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc lhs braces @@ -56564,12 +56483,11 @@ and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = let doc = match attrs with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in printComments doc cmtTbl loc -and printTemplateLiteral ~customLayout expr cmtTbl = +and printTemplateLiteral ~state expr cmtTbl = let tag = ref "js" in let rec walkExpr expr = let open Parsetree in @@ -56584,7 +56502,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = tag := prefix; printStringContents txt | _ -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in let content = walkExpr expr in @@ -56596,7 +56514,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = Doc.text "`"; ] -and printUnaryExpression ~customLayout expr cmtTbl = +and printUnaryExpression ~state expr cmtTbl = let printUnaryOperator op = Doc.text (match op with @@ -56612,7 +56530,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> let printedOperand = - let doc = printExpressionWithComments ~customLayout operand cmtTbl in + let doc = printExpressionWithComments ~state operand cmtTbl in match Parens.unaryExprOperand operand with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc operand braces @@ -56622,7 +56540,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = printComments doc cmtTbl expr.pexp_loc | _ -> assert false -and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = +and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with @@ -56669,7 +56587,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = right.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {right with pexp_attributes = rightInternalAttrs} cmtTbl in @@ -56680,10 +56598,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = in let doc = Doc.concat - [ - printAttributes ~customLayout rightPrinteableAttrs cmtTbl; - doc; - ] + [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] in match rightPrinteableAttrs with | [] -> doc @@ -56728,7 +56643,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {expr with pexp_attributes = internalAttrs} cmtTbl in @@ -56741,8 +56656,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat - [printAttributes ~customLayout printeableAttrs cmtTbl; doc] + Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -56750,19 +56664,19 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = printTemplateLiteral ~customLayout expr cmtTbl in + let doc = printTemplateLiteral ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - printSetFieldExpr ~customLayout expr.pexp_attributes lhs field rhs + printSetFieldExpr ~state expr.pexp_attributes lhs field rhs expr.pexp_loc cmtTbl in if isLhs then addParens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments ~customLayout rhs cmtTbl in - let lhsDoc = printExpressionWithComments ~customLayout lhs cmtTbl in + let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in + let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in (* TODO: unify indentation of "=" *) let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = @@ -56780,12 +56694,11 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in if isLhs then addParens doc else doc | _ -> ( - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.binaryExprOperand ~isLhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56800,15 +56713,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = when not (ParsetreeViewer.isBinaryExpression lhs || ParsetreeViewer.isBinaryExpression rhs - || printAttributes ~customLayout expr.pexp_attributes cmtTbl - <> Doc.nil) -> + || printAttributes ~state expr.pexp_attributes cmtTbl <> Doc.nil) -> let lhsHasCommentBelow = hasCommentBelow cmtTbl lhs.pexp_loc in let lhsDoc = printOperand ~isLhs:true lhs op in let rhsDoc = printOperand ~isLhs:false rhs op in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] @@ -56842,7 +56754,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; (match Parens.binaryExpr { @@ -56858,14 +56770,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ]) | _ -> Doc.nil -and printBeltListConcatApply ~customLayout subLists cmtTbl = +and printBeltListConcatApply ~state subLists cmtTbl = let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ commaBeforeSpread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56886,9 +56798,7 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -56916,13 +56826,13 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ]) (* callExpr(arg1, arg2) *) -and printPexpApply ~customLayout expr cmtTbl = +and printPexpApply ~state expr cmtTbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -56933,14 +56843,14 @@ and printPexpApply ~customLayout expr cmtTbl = match memberExpr.pexp_desc with | Pexp_ident lident -> printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments ~customLayout memberExpr cmtTbl + | _ -> printExpressionWithComments ~state memberExpr cmtTbl in Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -56950,7 +56860,7 @@ and printPexpApply ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.expr rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces @@ -56965,7 +56875,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printExpressionWithComments ~customLayout lhs cmtTbl; + printExpressionWithComments ~state lhs cmtTbl; Doc.text " ="; (if shouldIndent then Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) @@ -56974,8 +56884,8 @@ and printPexpApply ~customLayout expr cmtTbl = in match expr.pexp_attributes with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc])) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) @@ -56983,7 +56893,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -57000,7 +56910,7 @@ and printPexpApply ~customLayout expr cmtTbl = [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -57009,7 +56919,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -57021,7 +56931,7 @@ and printPexpApply ~customLayout expr cmtTbl = -> let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -57055,14 +56965,14 @@ and printPexpApply ~customLayout expr cmtTbl = || ParsetreeViewer.isArrayAccess e in let targetExpr = - let doc = printExpressionWithComments ~customLayout targetExpr cmtTbl in + let doc = printExpressionWithComments ~state targetExpr cmtTbl in match Parens.expr targetExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc targetExpr braces | Nothing -> doc in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -57071,7 +56981,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -57084,7 +56994,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression ~customLayout lident args cmtTbl + printJsxExpression ~state lident args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map @@ -57095,7 +57005,7 @@ and printPexpApply ~customLayout expr cmtTbl = ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes in let callExprDoc = - let doc = printExpressionWithComments ~customLayout callExpr cmtTbl in + let doc = printExpressionWithComments ~state callExpr cmtTbl in match Parens.callExpr callExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc callExpr braces @@ -57103,15 +57013,12 @@ and printPexpApply ~customLayout expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57133,19 +57040,18 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.concat [ maybeBreakParent; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc; ] else - let argsDoc = printArguments ~customLayout ~uncurried args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + let argsDoc = printArguments ~state ~uncurried args cmtTbl in + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false -and printJsxExpression ~customLayout lident args cmtTbl = +and printJsxExpression ~state lident args cmtTbl = let name = printJsxName lident in - let formattedProps, children = printJsxProps ~customLayout args cmtTbl in + let formattedProps, children = printJsxProps ~state args cmtTbl in (*
*) let hasChildren = match children with @@ -57184,8 +57090,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = Doc.line; (match children with | Some childrenExpression -> - printJsxChildren ~customLayout childrenExpression ~sep:lineSep - cmtTbl + printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl | None -> Doc.nil); ]); lineSep; @@ -57241,7 +57146,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = ]); ]) -and printJsxFragment ~customLayout expr cmtTbl = +and printJsxFragment ~state expr cmtTbl = let opening = Doc.text "<>" in let closing = Doc.text "" in let lineSep = @@ -57256,16 +57161,12 @@ and printJsxFragment ~customLayout expr cmtTbl = | _ -> Doc.indent (Doc.concat - [ - Doc.line; - printJsxChildren ~customLayout expr ~sep:lineSep cmtTbl; - ])); + [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); lineSep; closing; ]) -and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep - cmtTbl = +and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = match childrenExpr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in @@ -57276,9 +57177,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let addParensOrBraces exprDoc = (* {(20: int)} make sure that we also protect the expression inside *) let innerDoc = @@ -57297,9 +57196,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout childrenExpr cmtTbl - in + let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in Doc.concat [ Doc.dotdotdot; @@ -57314,8 +57211,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep | Nothing -> exprDoc); ] -and printJsxProps ~customLayout args cmtTbl : - Doc.t * Parsetree.expression option = +and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = (* This function was introduced because we have different formatting behavior for self-closing tags and other tags we always put /> on a new line for self-closing tag when it breaks expr.pexp_loc in let trailingCommentsPresent = hasTrailingComments cmtTbl loc in - let propDoc = printJsxProp ~customLayout lastProp cmtTbl in + let propDoc = printJsxProp ~state lastProp cmtTbl in let formattedProps = Doc.concat [ @@ -57387,12 +57283,12 @@ and printJsxProps ~customLayout args cmtTbl : in (formattedProps, Some children) | arg :: args -> - let propDoc = printJsxProp ~customLayout arg cmtTbl in + let propDoc = printJsxProp ~state arg cmtTbl in loop (propDoc :: props) args in loop [] args -and printJsxProp ~customLayout arg cmtTbl = +and printJsxProp ~state arg cmtTbl = match arg with | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { @@ -57418,7 +57314,7 @@ and printJsxProp ~customLayout arg cmtTbl = | Labelled _lbl -> printIdentLike ident | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; Doc.softLine; doc; Doc.rbrace] | lbl, expr -> let argLoc, expr = @@ -57441,7 +57337,7 @@ and printJsxProp ~customLayout arg cmtTbl = let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.jsxPropExpr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) @@ -57471,12 +57367,11 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = State.nextCustomLayout state in let cmtTblCopy = CommentTable.copy cmtTbl in let callback, printedArgs = match args with @@ -57491,17 +57386,14 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args in let callback = Doc.concat - [ - lblDoc; - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl; - ] + [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] in let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in let printedArgs = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~customLayout arg cmtTbl) args)) + (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) in (callback, printedArgs) | _ -> assert false @@ -57532,9 +57424,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * arg3, * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57551,16 +57441,15 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = state |> State.nextCustomLayout in let cmtTblCopy = CommentTable.copy cmtTbl in let cmtTblCopy2 = CommentTable.copy cmtTbl in let rec loop acc args = @@ -57578,7 +57467,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl + printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl in let doc = Doc.concat [lblDoc; pexpFunDoc] in printComments doc cmtTbl expr.pexp_loc) @@ -57586,7 +57475,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackArgumentsFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:ArgumentsFitOnOneLine expr + printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr cmtTblCopy in let doc = Doc.concat [lblDoc; pexpFunDoc] in @@ -57596,7 +57485,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args callbackFitsOnOneLine, callbackArgumentsFitsOnOneLine ) | arg :: args -> - let argDoc = printArgument ~customLayout arg cmtTbl in + let argDoc = printArgument ~state arg cmtTbl in loop (Doc.line :: Doc.comma :: argDoc :: acc) args in let printedArgs, callback, callback2 = loop [] args in @@ -57635,9 +57524,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy2) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57654,7 +57541,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout @@ -57664,7 +57551,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args Lazy.force breakAllArgs; ] -and printArguments ~customLayout ~uncurried +and printArguments ~state ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -57683,7 +57570,7 @@ and printArguments ~customLayout ~uncurried | _ -> Doc.text "()") | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -57702,9 +57589,7 @@ and printArguments ~customLayout ~uncurried (if uncurried then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> printArgument ~customLayout arg cmtTbl) - args); + (List.map (fun arg -> printArgument ~state arg cmtTbl) args); ]); Doc.trailingComma; Doc.softLine; @@ -57725,7 +57610,7 @@ and printArguments ~customLayout ~uncurried * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and printArgument ~customLayout (argLbl, arg) cmtTbl = +and printArgument ~state (argLbl, arg) cmtTbl = match (argLbl, arg) with (* ~a (punned)*) | ( Asttypes.Labelled lbl, @@ -57765,7 +57650,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = Doc.tilde; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in printComments doc cmtTbl loc @@ -57803,7 +57688,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = printComments doc cmtTbl argLoc in let printedExpr = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -57813,7 +57698,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = let doc = Doc.concat [printedLbl; printedExpr] in printComments doc cmtTbl loc -and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = +and printCases ~state (cases : Parsetree.case list) cmtTbl = Doc.breakableGroup ~forceBreak:true (Doc.concat [ @@ -57827,22 +57712,22 @@ and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = n.Parsetree.pc_lhs.ppat_loc with loc_end = n.pc_rhs.pexp_loc.loc_end; }) - ~print:(printCase ~customLayout) ~nodes:cases cmtTbl; + ~print:(printCase ~state) ~nodes:cases cmtTbl; ]; Doc.line; Doc.rbrace; ]) -and printCase ~customLayout (case : Parsetree.case) cmtTbl = +and printCase ~state (case : Parsetree.case) cmtTbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~customLayout + printExpressionBlock ~state ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) case.pc_rhs cmtTbl | _ -> ( - let doc = printExpressionWithComments ~customLayout case.pc_rhs cmtTbl in + let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in match Parens.expr case.pc_rhs with | Parenthesized -> addParens doc | _ -> doc) @@ -57857,7 +57742,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ]) in let shouldInlineRhs = @@ -57874,7 +57759,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = | _ -> true in let patternDoc = - let doc = printPattern ~customLayout case.pc_lhs cmtTbl in + let doc = printPattern ~state case.pc_lhs cmtTbl in match case.pc_lhs.ppat_desc with | Ppat_constraint _ -> addParens doc | _ -> doc @@ -57891,8 +57776,8 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = in Doc.group (Doc.concat [Doc.text "| "; content]) -and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried - ~hasConstraint parameters cmtTbl = +and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint + parameters cmtTbl = match parameters with (* let f = _ => () *) | [ @@ -57931,7 +57816,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried match attrs with | [] -> if hasConstraint then addParens var else var | attrs -> - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in addParens (Doc.concat [attrs; var]) in if async then addAsync var else var @@ -57973,7 +57858,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> printExpFunParameter ~customLayout p cmtTbl) + (fun p -> printExpFunParameter ~state p cmtTbl) parameters); ] in @@ -57988,13 +57873,13 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.rparen; ]) -and printExpFunParameter ~customLayout parameter cmtTbl = +and printExpFunParameter ~state parameter cmtTbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.text "type "; Doc.join ~sep:Doc.space (List.map @@ -58009,27 +57894,27 @@ and printExpFunParameter ~customLayout parameter cmtTbl = let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = match defaultExpr with | Some expr -> Doc.concat - [Doc.text "="; printExpressionWithComments ~customLayout expr cmtTbl] + [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) let labelWithPattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> printPattern ~customLayout pattern cmtTbl + | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl | ( (Asttypes.Labelled lbl | Optional lbl), {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) when lbl = stringLoc.txt -> (* ~d *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; ] @@ -58042,11 +57927,11 @@ and printExpFunParameter ~customLayout parameter cmtTbl = (* ~d: e *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) @@ -58055,7 +57940,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = Doc.text "~"; printIdentLike lbl; Doc.text " as "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; ] in let optionalLabelSuffix = @@ -58095,7 +57980,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = in printComments doc cmtTbl cmtLoc -and printExpressionBlock ~customLayout ~braces expr cmtTbl = +and printExpressionBlock ~state ~braces expr cmtTbl = let rec collectRows acc expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> @@ -58109,7 +57994,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = Doc.text "module "; name; Doc.text " = "; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; ] in let loc = {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} in @@ -58126,7 +58011,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = {cmtLoc with loc_end = loc.loc_end} in let letExceptionDoc = - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl in collectRows ((loc, letExceptionDoc) :: acc) expr2 | Pexp_open (overrideFlag, longidentLoc, expr2) -> @@ -58143,7 +58028,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = collectRows ((loc, openDoc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> let exprDoc = - let doc = printExpression ~customLayout expr1 cmtTbl in + let doc = printExpression ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -58170,9 +58055,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl - in + let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in (* let () = { * let () = foo() * () @@ -58185,7 +58068,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | _ -> collectRows ((loc, letDoc) :: acc) expr2) | _ -> let exprDoc = - let doc = printExpression ~customLayout expr cmtTbl in + let doc = printExpression ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58262,7 +58145,7 @@ and printDirectionFlag flag = | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = +and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group @@ -58272,7 +58155,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = (* print punned field *) Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; printOptionalLabel expr.pexp_attributes; printLidentPath lbl cmtTbl; ] @@ -58282,7 +58165,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = printLidentPath lbl cmtTbl; Doc.text ": "; printOptionalLabel expr.pexp_attributes; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.exprRecordRowRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58291,7 +58174,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = in printComments doc cmtTbl cmtLoc -and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = +and printBsObjectRow ~state (lbl, expr) cmtTbl = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let lblDoc = let doc = @@ -58304,7 +58187,7 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = [ lblDoc; Doc.text ": "; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -58319,8 +58202,8 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and printAttributes ?loc ?(inline = false) ~customLayout - (attrs : Parsetree.attributes) cmtTbl = +and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmtTbl = match ParsetreeViewer.filterParsingAttrs attrs with | [] -> Doc.nil | attrs -> @@ -58338,17 +58221,15 @@ and printAttributes ?loc ?(inline = false) ~customLayout [ Doc.group (Doc.joinWithSep - (List.map - (fun attr -> printAttribute ~customLayout attr cmtTbl) - attrs)); + (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); (if inline then Doc.space else lineBreak); ] -and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = +and printPayload ~state (payload : Parsetree.payload) cmtTbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments ~customLayout expr cmtTbl in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let needsParens = match attrs with | [] -> false @@ -58359,7 +58240,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.concat [ Doc.lparen; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); Doc.rparen; ] @@ -58371,22 +58252,21 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = (Doc.concat [ Doc.softLine; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); ]); Doc.softLine; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - addParens (printStructureItem ~customLayout si cmtTbl) - | PStr structure -> addParens (printStructure ~customLayout structure cmtTbl) + addParens (printStructureItem ~state si cmtTbl) + | PStr structure -> addParens (printStructure ~state structure cmtTbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent - (Doc.concat [Doc.line; printTypExpr ~customLayout typ cmtTbl]); + Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); Doc.softLine; Doc.rparen; ] @@ -58398,7 +58278,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ] | None -> Doc.nil in @@ -58410,7 +58290,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.softLine; Doc.text "? "; - printPattern ~customLayout pat cmtTbl; + printPattern ~state pat cmtTbl; whenDoc; ]); Doc.softLine; @@ -58422,12 +58302,12 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.softLine; Doc.rparen; ] -and printAttribute ?(standalone = false) ~customLayout +and printAttribute ?(standalone = false) ~state ((id, payload) : Parsetree.attribute) cmtTbl = match (id, payload) with | ( {txt = "ns.doc"}, @@ -58451,11 +58331,11 @@ and printAttribute ?(standalone = false) ~customLayout [ Doc.text (if standalone then "@@" else "@"); Doc.text (convertBsExternalAttribute id.txt); - printPayload ~customLayout payload cmtTbl; + printPayload ~state payload cmtTbl; ]), Doc.line ) -and printModExpr ~customLayout modExpr cmtTbl = +and printModExpr ~state modExpr cmtTbl = let doc = match modExpr.pmod_desc with | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl @@ -58473,7 +58353,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.lbrace; Doc.indent (Doc.concat - [Doc.softLine; printStructure ~customLayout structure cmtTbl]); + [Doc.softLine; printStructure ~state structure cmtTbl]); Doc.softLine; Doc.rbrace; ]) @@ -58493,7 +58373,7 @@ and printModExpr ~customLayout modExpr cmtTbl = (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> let packageDoc = let doc = - printPackageType ~customLayout ~printModuleKeywordAndParens:false + printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl in printComments doc cmtTbl ptyp_loc @@ -58509,10 +58389,7 @@ and printModExpr ~customLayout modExpr cmtTbl = let unpackDoc = Doc.group (Doc.concat - [ - printExpressionWithComments ~customLayout expr cmtTbl; - moduleConstraint; - ]) + [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) in Doc.group (Doc.concat @@ -58528,7 +58405,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.rparen; ]) | Pmod_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmod_apply _ -> let args, callExpr = ParsetreeViewer.modExprApply modExpr in let isUnitSugar = @@ -58544,17 +58421,15 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.group (Doc.concat [ - printModExpr ~customLayout callExpr cmtTbl; + printModExpr ~state callExpr cmtTbl; (if isUnitSugar then - printModApplyArg ~customLayout - (List.hd args [@doesNotRaise]) - cmtTbl + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else Doc.concat [ Doc.lparen; (if shouldHug then - printModApplyArg ~customLayout + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else @@ -58566,7 +58441,7 @@ and printModExpr ~customLayout modExpr cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun modArg -> - printModApplyArg ~customLayout modArg cmtTbl) + printModApplyArg ~state modArg cmtTbl) args); ])); (if not shouldHug then @@ -58578,15 +58453,15 @@ and printModExpr ~customLayout modExpr cmtTbl = | Pmod_constraint (modExpr, modType) -> Doc.concat [ - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - printModType ~customLayout modType cmtTbl; + printModType ~state modType cmtTbl; ] - | Pmod_functor _ -> printModFunctor ~customLayout modExpr cmtTbl + | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl in printComments doc cmtTbl modExpr.pmod_loc -and printModFunctor ~customLayout modExpr cmtTbl = +and printModFunctor ~state modExpr cmtTbl = let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) @@ -58597,18 +58472,18 @@ and printModFunctor ~customLayout modExpr cmtTbl = match returnModExpr.pmod_desc with | Pmod_constraint (modExpr, modType) -> let constraintDoc = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modExprFunctorConstraint modType then addParens doc else doc in let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in - (modConstraint, printModExpr ~customLayout modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr ~customLayout returnModExpr cmtTbl) + (modConstraint, printModExpr ~state modExpr cmtTbl) + | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) in let parametersDoc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; Doc.text "()"]) + (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -58622,8 +58497,7 @@ and printModFunctor ~customLayout modExpr cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> - printModFunctorParam ~customLayout param cmtTbl) + (fun param -> printModFunctorParam ~state param cmtTbl) parameters); ]); Doc.trailingComma; @@ -58635,14 +58509,14 @@ and printModFunctor ~customLayout modExpr cmtTbl = (Doc.concat [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) -and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = +and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = let cmtLoc = match optModType with | None -> lbl.Asttypes.loc | Some modType -> {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let lblDoc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in printComments doc cmtTbl lbl.loc @@ -58656,19 +58530,17 @@ and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = (match optModType with | None -> Doc.nil | Some modType -> - Doc.concat - [Doc.text ": "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); ]) in printComments doc cmtTbl cmtLoc -and printModApplyArg ~customLayout modExpr cmtTbl = +and printModApplyArg ~state modExpr cmtTbl = match modExpr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr ~customLayout modExpr cmtTbl + | _ -> printModExpr ~state modExpr cmtTbl -and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) - cmtTbl = +and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = let kind = match constr.pext_kind with | Pext_rebind longident -> @@ -58679,15 +58551,11 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc @@ -58696,7 +58564,7 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) Doc.group (Doc.concat [ - printAttributes ~customLayout constr.pext_attributes cmtTbl; + printAttributes ~state constr.pext_attributes cmtTbl; Doc.text "exception "; name; kind; @@ -58704,9 +58572,9 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) in printComments doc cmtTbl constr.pext_loc -and printExtensionConstructor ~customLayout - (constr : Parsetree.extension_constructor) cmtTbl i = - let attrs = printAttributes ~customLayout constr.pext_attributes cmtTbl in +and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) + cmtTbl i = + let attrs = printAttributes ~state constr.pext_attributes cmtTbl in let bar = if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil in @@ -58720,40 +58588,36 @@ and printExtensionConstructor ~customLayout | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -let printTypeParams = printTypeParams ~customLayout:0 -let printTypExpr = printTypExpr ~customLayout:0 -let printExpression = printExpression ~customLayout:0 -let printPattern = printPattern ~customLayout:0 +let printTypeParams = printTypeParams ~state:State.init +let printTypExpr = printTypExpr ~state:State.init +let printExpression = printExpression ~state:State.init +let printPattern = printPattern ~state:State.init let printImplementation ~width (s : Parsetree.structure) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkStructure s cmtTbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure ~customLayout:0 s cmtTbl in + let doc = printStructure ~state:State.init s cmtTbl in (* Doc.debug doc; *) Doc.toString ~width doc ^ "\n" let printInterface ~width (s : Parsetree.signature) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkSignature s cmtTbl comments; - Doc.toString ~width (printSignature ~customLayout:0 s cmtTbl) ^ "\n" + Doc.toString ~width (printSignature ~state:State.init s cmtTbl) ^ "\n" -let printStructure = printStructure ~customLayout:0 +let printStructure = printStructure ~state:State.init end module Pattern_printer : sig diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index d84b891999..67414430a4 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -108632,19 +108632,29 @@ let printOptionalLabel attrs = if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" else Doc.nil -let customLayoutThreshold = 2 +module State = struct + let customLayoutThreshold = 2 -let rec printStructure ~customLayout (s : Parsetree.structure) t = + type t = {customLayout: int; uncurried: bool} + + let init = {customLayout = 0; uncurried = false} + + let nextCustomLayout t = {t with customLayout = t.customLayout + 1} + + let shouldBreakCallback t = t.customLayout > customLayoutThreshold +end + +let rec printStructure ~state (s : Parsetree.structure) t = match s with | [] -> printCommentsInsideFile t | structure -> printList ~getLoc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(printStructureItem ~customLayout) + ~print:(printStructureItem ~state) t -and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = +and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = match si.pstr_desc with | Pstr_value (rec_flag, valueBindings) -> let recFlag = @@ -108652,58 +108662,56 @@ and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl + printValueBindings ~state ~recFlag valueBindings cmtTbl | Pstr_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl | Pstr_primitive valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Pstr_eval (expr, attrs) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.structureExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] | Pstr_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Pstr_include includeDeclaration -> - printIncludeDeclaration ~customLayout includeDeclaration cmtTbl + printIncludeDeclaration ~state includeDeclaration cmtTbl | Pstr_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Pstr_module moduleBinding -> - printModuleBinding ~customLayout ~isRec:false moduleBinding cmtTbl 0 + printModuleBinding ~state ~isRec:false moduleBinding cmtTbl 0 | Pstr_recmodule moduleBindings -> printListi ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) ~nodes:moduleBindings - ~print:(printModuleBinding ~customLayout ~isRec:true) + ~print:(printModuleBinding ~state ~isRec:true) cmtTbl | Pstr_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl - | Pstr_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl + | Pstr_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil -and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = +and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = let prefix = Doc.text "type " in let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams ~customLayout te.ptyext_params cmtTbl in + let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in let extensionConstructors = let ecs = te.ptyext_constructors in let forceBreak = @@ -108721,7 +108729,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = let rows = printListi ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:(printExtensionConstructor ~customLayout) + ~print:(printExtensionConstructor ~state) ~nodes:ecs ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak @@ -108739,8 +108747,8 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout ~loc:te.ptyext_path.loc - te.ptyext_attributes cmtTbl; + printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmtTbl; prefix; name; typeParams; @@ -108748,7 +108756,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = extensionConstructors; ]) -and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = +and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = let prefix = if i = 0 then Doc.concat @@ -108758,9 +108766,9 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let modExprDoc, modConstraintDoc = match moduleBinding.pmb_expr with | {pmod_desc = Pmod_constraint (modExpr, modType)} -> - ( printModExpr ~customLayout modExpr cmtTbl, - Doc.concat [Doc.text ": "; printModType ~customLayout modType cmtTbl] ) - | modExpr -> (printModExpr ~customLayout modExpr cmtTbl, Doc.nil) + ( printModExpr ~state modExpr cmtTbl, + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] ) + | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil) in let modName = let doc = Doc.text moduleBinding.pmb_name.Location.txt in @@ -108769,7 +108777,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:moduleBinding.pmb_name.loc + printAttributes ~state ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes cmtTbl; prefix; modName; @@ -108780,7 +108788,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = in printComments doc cmtTbl moduleBinding.pmb_loc -and printModuleTypeDeclaration ~customLayout +and printModuleTypeDeclaration ~state (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = let modName = let doc = Doc.text modTypeDecl.pmtd_name.txt in @@ -108788,23 +108796,23 @@ and printModuleTypeDeclaration ~customLayout in Doc.concat [ - printAttributes ~customLayout modTypeDecl.pmtd_attributes cmtTbl; + printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; Doc.text "module type "; modName; (match modTypeDecl.pmtd_type with | None -> Doc.nil | Some modType -> - Doc.concat [Doc.text " = "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); ] -and printModType ~customLayout modType cmtTbl = +and printModType ~state modType cmtTbl = let modTypeDoc = match modType.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~customLayout ~loc:longident.loc - modType.pmty_attributes cmtTbl; + printAttributes ~state ~loc:longident.loc modType.pmty_attributes + cmtTbl; printLongidentLocation longident cmtTbl; ] | Pmty_signature [] -> @@ -108825,17 +108833,13 @@ and printModType ~customLayout modType cmtTbl = [ Doc.lbrace; Doc.indent - (Doc.concat - [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [ - printAttributes ~customLayout modType.pmty_attributes cmtTbl; - signatureDoc; - ] + [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] | Pmty_functor _ -> let parameters, returnType = ParsetreeViewer.functorType modType in let parametersDoc = @@ -108845,10 +108849,8 @@ and printModType ~customLayout modType cmtTbl = let cmtLoc = {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in - let doc = - Doc.concat [attrs; printModType ~customLayout modType cmtTbl] - in + let attrs = printAttributes ~state attrs cmtTbl in + let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in printComments doc cmtTbl cmtLoc | params -> Doc.group @@ -108874,7 +108876,7 @@ and printModType ~customLayout modType cmtTbl = } in let attrs = - printAttributes ~customLayout attrs cmtTbl + printAttributes ~state attrs cmtTbl in let lblDoc = if lbl.Location.txt = "_" || lbl.txt = "*" then @@ -108895,8 +108897,7 @@ and printModType ~customLayout modType cmtTbl = [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - printModType ~customLayout modType - cmtTbl; + printModType ~state modType cmtTbl; ]); ] in @@ -108909,7 +108910,7 @@ and printModType ~customLayout modType cmtTbl = ]) in let returnDoc = - let doc = printModType ~customLayout returnType cmtTbl in + let doc = printModType ~state returnType cmtTbl in if Parens.modTypeFunctorReturn returnType then addParens doc else doc in Doc.group @@ -108920,14 +108921,14 @@ and printModType ~customLayout modType cmtTbl = ]) | Pmty_typeof modExpr -> Doc.concat - [Doc.text "module type of "; printModExpr ~customLayout modExpr cmtTbl] + [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] | Pmty_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmty_alias longident -> Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] | Pmty_with (modType, withConstraints) -> let operand = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modTypeWithOperand modType then addParens doc else doc in Doc.group @@ -108936,10 +108937,7 @@ and printModType ~customLayout modType cmtTbl = operand; Doc.indent (Doc.concat - [ - Doc.line; - printWithConstraints ~customLayout withConstraints cmtTbl; - ]); + [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); ]) in let attrsAlreadyPrinted = @@ -108951,13 +108949,13 @@ and printModType ~customLayout modType cmtTbl = Doc.concat [ (if attrsAlreadyPrinted then Doc.nil - else printAttributes ~customLayout modType.pmty_attributes cmtTbl); + else printAttributes ~state modType.pmty_attributes cmtTbl); modTypeDoc; ] in printComments doc cmtTbl modType.pmty_loc -and printWithConstraints ~customLayout withConstraints cmtTbl = +and printWithConstraints ~state withConstraints cmtTbl = let rows = List.mapi (fun i withConstraint -> @@ -108965,19 +108963,19 @@ and printWithConstraints ~customLayout withConstraints cmtTbl = (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - printWithConstraint ~customLayout withConstraint cmtTbl; + printWithConstraint ~state withConstraint cmtTbl; ])) withConstraints in Doc.join ~sep:Doc.line rows -and printWithConstraint ~customLayout - (withConstraint : Parsetree.with_constraint) cmtTbl = +and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) + cmtTbl = match withConstraint with (* with type X.t = ... *) | Pwith_type (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) (* with module X.Y = Z *) @@ -108992,7 +108990,7 @@ and printWithConstraint ~customLayout (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_typesubst (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> @@ -109004,60 +109002,58 @@ and printWithConstraint ~customLayout Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] -and printSignature ~customLayout signature cmtTbl = +and printSignature ~state signature cmtTbl = match signature with | [] -> printCommentsInsideFile cmtTbl | signature -> printList ~getLoc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(printSignatureItem ~customLayout) + ~print:(printSignatureItem ~state) cmtTbl -and printSignatureItem ~customLayout (si : Parsetree.signature_item) cmtTbl = +and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = match si.psig_desc with | Parsetree.Psig_value valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Psig_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl - | Psig_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Psig_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Psig_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl | Psig_module moduleDeclaration -> - printModuleDeclaration ~customLayout moduleDeclaration cmtTbl + printModuleDeclaration ~state moduleDeclaration cmtTbl | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl + printRecModuleDeclarations ~state moduleDeclarations cmtTbl | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Psig_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Psig_include includeDescription -> - printIncludeDescription ~customLayout includeDescription cmtTbl + printIncludeDescription ~state includeDescription cmtTbl | Psig_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl = +and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.pmd_loc) ~nodes:moduleDeclarations - ~print:(printRecModuleDeclaration ~customLayout) + ~print:(printRecModuleDeclaration ~state) cmtTbl -and printRecModuleDeclaration ~customLayout md cmtTbl i = +and printRecModuleDeclaration ~state md cmtTbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> @@ -109069,7 +109065,7 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = | _ -> false in let modTypeDoc = - let doc = printModType ~customLayout md.pmd_type cmtTbl in + let doc = printModType ~state md.pmd_type cmtTbl in if needsParens then addParens doc else doc in Doc.concat [Doc.text ": "; modTypeDoc] @@ -109077,34 +109073,32 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text prefix; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printModuleDeclaration ~customLayout (md : Parsetree.module_declaration) - cmtTbl = +and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> - Doc.concat [Doc.text ": "; printModType ~customLayout md.pmd_type cmtTbl] + | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text "module "; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printOpenDescription ~customLayout - (openDescription : Parsetree.open_description) cmtTbl = +and printOpenDescription ~state (openDescription : Parsetree.open_description) + cmtTbl = Doc.concat [ - printAttributes ~customLayout openDescription.popen_attributes cmtTbl; + printAttributes ~state openDescription.popen_attributes cmtTbl; Doc.text "open"; (match openDescription.popen_override with | Asttypes.Fresh -> Doc.space @@ -109112,45 +109106,45 @@ and printOpenDescription ~customLayout printLongidentLocation openDescription.popen_lid cmtTbl; ] -and printIncludeDescription ~customLayout +and printIncludeDescription ~state (includeDescription : Parsetree.include_description) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDescription.pincl_attributes cmtTbl; + printAttributes ~state includeDescription.pincl_attributes cmtTbl; Doc.text "include "; - printModType ~customLayout includeDescription.pincl_mod cmtTbl; + printModType ~state includeDescription.pincl_mod cmtTbl; ] -and printIncludeDeclaration ~customLayout +and printIncludeDeclaration ~state (includeDeclaration : Parsetree.include_declaration) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDeclaration.pincl_attributes cmtTbl; + printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; Doc.text "include "; (let includeDoc = - printModExpr ~customLayout includeDeclaration.pincl_mod cmtTbl + printModExpr ~state includeDeclaration.pincl_mod cmtTbl in if Parens.includeModExpr includeDeclaration.pincl_mod then addParens includeDoc else includeDoc); ] -and printValueBindings ~customLayout ~recFlag - (vbs : Parsetree.value_binding list) cmtTbl = +and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) + cmtTbl = printListi ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~customLayout ~recFlag) + ~print:(printValueBinding ~state ~recFlag) cmtTbl -and printValueDescription ~customLayout valueDescription cmtTbl = +and printValueDescription ~state valueDescription cmtTbl = let isExternal = match valueDescription.pval_prim with | [] -> false | _ -> true in let attrs = - printAttributes ~customLayout ~loc:valueDescription.pval_name.loc + printAttributes ~state ~loc:valueDescription.pval_name.loc valueDescription.pval_attributes cmtTbl in let header = if isExternal then "external " else "let " in @@ -109163,7 +109157,7 @@ and printValueDescription ~customLayout valueDescription cmtTbl = (printIdentLike valueDescription.pval_name.txt) cmtTbl valueDescription.pval_name.loc; Doc.text ": "; - printTypExpr ~customLayout valueDescription.pval_type cmtTbl; + printTypExpr ~state valueDescription.pval_type cmtTbl; (if isExternal then Doc.group (Doc.concat @@ -109184,11 +109178,11 @@ and printValueDescription ~customLayout valueDescription cmtTbl = else Doc.nil); ]) -and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = +and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.ptype_loc) ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~customLayout ~recFlag) + ~print:(printTypeDeclaration2 ~state ~recFlag) cmtTbl (* @@ -109223,16 +109217,16 @@ and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i +and printTypeDeclaration ~state ~name ~equalSign ~recFlag i (td : Parsetree.type_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -109243,7 +109237,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -109260,7 +109254,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -109268,7 +109262,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -109278,39 +109272,37 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDeclaration2 ~customLayout ~recFlag - (td : Parsetree.type_declaration) cmtTbl i = +and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) + cmtTbl i = let name = let doc = printIdentLike td.Parsetree.ptype_name.txt in printComments doc cmtTbl td.ptype_name.loc in let equalSign = "=" in let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -109321,7 +109313,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -109349,7 +109341,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -109357,7 +109349,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -109367,25 +109359,23 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDefinitionConstraints ~customLayout cstrs = +and printTypeDefinitionConstraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -109396,20 +109386,18 @@ and printTypeDefinitionConstraints ~customLayout cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map - (printTypeDefinitionConstraint ~customLayout) - cstrs)); + (List.map (printTypeDefinitionConstraint ~state) cstrs)); ])) -and printTypeDefinitionConstraint ~customLayout +and printTypeDefinitionConstraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr ~customLayout typ1 CommentTable.empty; + printTypExpr ~state typ1 CommentTable.empty; Doc.text " = "; - printTypExpr ~customLayout typ2 CommentTable.empty; + printTypExpr ~state typ2 CommentTable.empty; ] and printPrivateFlag (flag : Asttypes.private_flag) = @@ -109417,7 +109405,7 @@ and printPrivateFlag (flag : Asttypes.private_flag) = | Private -> Doc.text "private " | Public -> Doc.nil -and printTypeParams ~customLayout typeParams cmtTbl = +and printTypeParams ~state typeParams cmtTbl = match typeParams with | [] -> Doc.nil | typeParams -> @@ -109433,9 +109421,7 @@ and printTypeParams ~customLayout typeParams cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun typeParam -> - let doc = - printTypeParam ~customLayout typeParam cmtTbl - in + let doc = printTypeParam ~state typeParam cmtTbl in printComments doc cmtTbl (fst typeParam).Parsetree.ptyp_loc) typeParams); @@ -109445,8 +109431,8 @@ and printTypeParams ~customLayout typeParams cmtTbl = Doc.greaterThan; ]) -and printTypeParam ~customLayout - (param : Parsetree.core_type * Asttypes.variance) cmtTbl = +and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) + cmtTbl = let typ, variance = param in let printedVariance = match variance with @@ -109454,10 +109440,10 @@ and printTypeParam ~customLayout | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printedVariance; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] -and printRecordDeclaration ~customLayout - (lds : Parsetree.label_declaration list) cmtTbl = +and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) + cmtTbl = let forceBreak = match (lds, List.rev lds) with | first :: _, last :: _ -> @@ -109476,9 +109462,7 @@ and printRecordDeclaration ~customLayout ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -109487,7 +109471,7 @@ and printRecordDeclaration ~customLayout Doc.rbrace; ]) -and printConstructorDeclarations ~customLayout ~privateFlag +and printConstructorDeclarations ~state ~privateFlag (cds : Parsetree.constructor_declaration list) cmtTbl = let forceBreak = match (cds, List.rev cds) with @@ -109505,16 +109489,16 @@ and printConstructorDeclarations ~customLayout ~privateFlag ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds ~print:(fun cd cmtTbl i -> - let doc = printConstructorDeclaration2 ~customLayout i cd cmtTbl in + let doc = printConstructorDeclaration2 ~state i cd cmtTbl in printComments doc cmtTbl cd.Parsetree.pcd_loc) ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak (Doc.indent (Doc.concat [Doc.line; privateFlag; rows])) -and printConstructorDeclaration2 ~customLayout i +and printConstructorDeclaration2 ~state i (cd : Parsetree.constructor_declaration) cmtTbl = - let attrs = printAttributes ~customLayout cd.pcd_attributes cmtTbl in + let attrs = printAttributes ~state cd.pcd_attributes cmtTbl in let bar = if i > 0 || cd.pcd_attributes <> [] then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil @@ -109524,14 +109508,13 @@ and printConstructorDeclaration2 ~customLayout i printComments doc cmtTbl cd.pcd_name.loc in let constrArgs = - printConstructorArguments ~customLayout ~indent:true cd.pcd_args cmtTbl + printConstructorArguments ~state ~indent:true cd.pcd_args cmtTbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent - (Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl]) + Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) in Doc.concat [ @@ -109547,7 +109530,7 @@ and printConstructorDeclaration2 ~customLayout i ]); ] -and printConstructorArguments ~customLayout ~indent +and printConstructorArguments ~state ~indent (cdArgs : Parsetree.constructor_arguments) cmtTbl = match cdArgs with | Pcstr_tuple [] -> Doc.nil @@ -109563,7 +109546,7 @@ and printConstructorArguments ~customLayout ~indent Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -109587,9 +109570,7 @@ and printConstructorArguments ~customLayout ~indent ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -109601,10 +109582,9 @@ and printConstructorArguments ~customLayout ~indent in if indent then Doc.indent args else args -and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) - cmtTbl = +and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl + printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl in let mutableFlag = match ld.pld_mutable with @@ -109624,10 +109604,10 @@ and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) name; optional; Doc.text ": "; - printTypExpr ~customLayout ld.pld_type cmtTbl; + printTypExpr ~state ld.pld_type cmtTbl; ]) -and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = +and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = @@ -109643,7 +109623,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | _ -> false in let returnDoc = - let doc = printTypExpr ~customLayout returnType cmtTbl in + let doc = printTypExpr ~state returnType cmtTbl in if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in @@ -109653,11 +109633,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl + printAttributes ~state ~inline:true attrsBefore cmtTbl else Doc.nil in let typDoc = - let doc = printTypExpr ~customLayout n cmtTbl in + let doc = printTypExpr ~state n cmtTbl in match n.ptyp_desc with | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc | _ -> doc @@ -109680,9 +109660,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = else Doc.concat [typDoc; Doc.text " => "; returnDoc]); ]) | args -> - let attrs = - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl - in + let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in let renderedArgs = Doc.concat [ @@ -109697,7 +109675,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun tp -> printTypeParameter ~customLayout tp cmtTbl) + (fun tp -> printTypeParameter ~state tp cmtTbl) args); ]); Doc.trailingComma; @@ -109713,7 +109691,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_var var -> Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] | Ptyp_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Ptyp_alias (typ, alias) -> let typ = (* Technically type t = (string, float) => unit as 'x, doesn't require @@ -109725,14 +109703,14 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] (* object printings *) | Ptyp_object (fields, openFlag) -> - printObject ~customLayout ~inline:false fields openFlag cmtTbl + printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in @@ -109752,7 +109730,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printObject ~customLayout ~inline:true fields openFlag cmtTbl; + printObject ~state ~inline:true fields openFlag cmtTbl; Doc.greaterThan; ] | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> @@ -109762,7 +109740,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printTupleType ~customLayout ~inline:true tuple cmtTbl; + printTupleType ~state ~inline:true tuple cmtTbl; Doc.greaterThan; ]) | Ptyp_constr (longidentLoc, constrArgs) -> ( @@ -109782,17 +109760,15 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> - printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) constrArgs); ]); Doc.trailingComma; Doc.softLine; Doc.greaterThan; ])) - | Ptyp_tuple types -> - printTupleType ~customLayout ~inline:false types cmtTbl - | Ptyp_poly ([], typ) -> printTypExpr ~customLayout typ cmtTbl + | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl + | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl | Ptyp_poly (stringLocs, typ) -> Doc.concat [ @@ -109804,11 +109780,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = stringLocs); Doc.dot; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | Ptyp_package packageType -> - printPackageType ~customLayout ~printModuleKeywordAndParens:true - packageType cmtTbl + printPackageType ~state ~printModuleKeywordAndParens:true packageType + cmtTbl | Ptyp_class _ -> Doc.text "classes are not supported in types" | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> let forceBreak = @@ -109821,7 +109797,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; ]) in @@ -109829,10 +109805,9 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Rtag ({txt}, attrs, truth, types) -> let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr ~customLayout t cmtTbl + | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl | _ -> - Doc.concat - [Doc.lparen; printTypExpr ~customLayout t cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] in let printedTypes = List.map doType types in let cases = @@ -109844,11 +109819,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; cases; ]) - | Rinherit coreType -> printTypExpr ~customLayout coreType cmtTbl + | Rinherit coreType -> printTypExpr ~state coreType cmtTbl in let docs = List.map printRowField rowFields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in @@ -109894,13 +109869,12 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let doc = match typExpr.ptyp_attributes with | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; renderedType]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) | _ -> renderedType in printComments doc cmtTbl typExpr.ptyp_loc -and printObject ~customLayout ~inline fields openFlag cmtTbl = +and printObject ~state ~inline fields openFlag cmtTbl = let doc = match fields with | [] -> @@ -109931,7 +109905,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> printObjectField ~customLayout field cmtTbl) + (fun field -> printObjectField ~state field cmtTbl) fields); ]); Doc.trailingComma; @@ -109941,8 +109915,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = in if inline then doc else Doc.group doc -and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) - cmtTbl = +and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = let tuple = Doc.concat [ @@ -109954,7 +109927,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -109964,7 +109937,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) in if inline == false then Doc.group tuple else tuple -and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = +and printObjectField ~state (field : Parsetree.object_field) cmtTbl = match field with | Otag (labelLoc, attrs, typ) -> let lbl = @@ -109974,27 +109947,27 @@ and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:labelLoc.loc attrs cmtTbl; + printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in printComments doc cmtTbl cmtLoc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; printTypExpr ~customLayout typexpr cmtTbl] + Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = +and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with | Asttypes.Nolabel -> Doc.nil @@ -110022,17 +109995,15 @@ and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = uncurried; attrs; label; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; optionalIndicator; ]) in printComments doc cmtTbl loc -and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) - cmtTbl i = +and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = let attrs = - printAttributes ~customLayout ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes - cmtTbl + printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl in let header = if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " @@ -110066,7 +110037,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -110074,13 +110045,10 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ]) | _ -> @@ -110093,7 +110061,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -110101,25 +110069,22 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout patTyp cmtTbl; + printTypExpr ~state patTyp cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ])) | _ -> let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in let printedExpr = - let doc = printExpressionWithComments ~customLayout vb.pvb_expr cmtTbl in + let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in match Parens.expr vb.pvb_expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let patternDoc = printPattern ~customLayout vb.pvb_pat cmtTbl in + let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -110181,7 +110146,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) else Doc.concat [Doc.space; printedExpr]); ]) -and printPackageType ~customLayout ~printModuleKeywordAndParens +and printPackageType ~state ~printModuleKeywordAndParens (packageType : Parsetree.package_type) cmtTbl = let doc = match packageType with @@ -110192,7 +110157,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens (Doc.concat [ printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints ~customLayout packageConstraints cmtTbl; + printPackageConstraints ~state packageConstraints cmtTbl; Doc.softLine; ]) in @@ -110200,7 +110165,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and printPackageConstraints ~customLayout packageConstraints cmtTbl = +and printPackageConstraints ~state packageConstraints cmtTbl = Doc.concat [ Doc.text " with"; @@ -110218,25 +110183,23 @@ and printPackageConstraints ~customLayout packageConstraints cmtTbl = loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = - printPackageConstraint ~customLayout i cmtTbl pc - in + let doc = printPackageConstraint ~state i cmtTbl pc in printComments doc cmtTbl cmtLoc) packageConstraints); ]); ] -and printPackageConstraint ~customLayout i cmtTbl (longidentLoc, typ) = +and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; printLongidentLocation longidentLoc cmtTbl; Doc.text " = "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] -and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = +and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = let txt = convertBsExtension stringLoc.Location.txt in let extName = let doc = @@ -110249,9 +110212,9 @@ and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = in printComments doc cmtTbl stringLoc.Location.loc in - Doc.group (Doc.concat [extName; printPayload ~customLayout payload cmtTbl]) + Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) -and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = +and printPattern ~state (p : Parsetree.pattern) cmtTbl = let patternWithoutAttributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" @@ -110273,7 +110236,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -110295,7 +110258,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -110324,15 +110287,12 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = (if shouldHug then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) - patterns); + (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat - [Doc.text "..."; printPattern ~customLayout tail cmtTbl] + Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] in let tail = printComments doc cmtTbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); @@ -110368,8 +110328,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -110381,7 +110340,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -110389,7 +110348,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -110420,8 +110379,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -110433,7 +110391,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -110441,7 +110399,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -110472,8 +110430,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printPatternRecordRow ~customLayout row cmtTbl) + (fun row -> printPatternRecordRow ~state row cmtTbl) rows); (match openFlag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] @@ -110490,7 +110447,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.group (Doc.concat [Doc.text "exception"; Doc.line; pat]) @@ -110500,7 +110457,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = let docs = List.mapi (fun i pat -> - let patternDoc = printPattern ~customLayout pat cmtTbl in + let patternDoc = printPattern ~state pat cmtTbl in Doc.concat [ (if i == 0 then Doc.nil @@ -110519,8 +110476,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) - | Ppat_extension ext -> - printExtension ~customLayout ~atModuleLvl:false ext cmtTbl + | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> let needsParens = match p.ppat_desc with @@ -110528,7 +110484,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] @@ -110539,7 +110495,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let renderedPattern = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat @@ -110555,7 +110511,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.text ": "; printComments - (printPackageType ~customLayout ~printModuleKeywordAndParens:false + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; Doc.rparen; @@ -110563,9 +110519,9 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) @@ -110586,13 +110542,11 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | attrs -> Doc.group (Doc.concat - [ - printAttributes ~customLayout attrs cmtTbl; patternWithoutAttributes; - ]) + [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) in printComments doc cmtTbl p.ppat_loc -and printPatternRecordRow ~customLayout row cmtTbl = +and printPatternRecordRow ~state row cmtTbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -110601,7 +110555,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = Doc.concat [ printOptionalLabel ppat_attributes; - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; printLidentPath longident cmtTbl; ] | longident, pattern -> @@ -110609,7 +110563,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in let rhsDoc = - let doc = printPattern ~customLayout pattern cmtTbl in + let doc = printPattern ~state pattern cmtTbl in let doc = if Parens.patternRecordRowRhs pattern then addParens doc else doc in @@ -110628,11 +110582,11 @@ and printPatternRecordRow ~customLayout row cmtTbl = in printComments doc cmtTbl locForComments -and printExpressionWithComments ~customLayout expr cmtTbl : Doc.t = - let doc = printExpression ~customLayout expr cmtTbl in +and printExpressionWithComments ~state expr cmtTbl : Doc.t = + let doc = printExpression ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc -and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = +and printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = let ifDocs = Doc.join ~sep:Doc.space (List.mapi @@ -110643,11 +110597,9 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | ParsetreeViewer.If ifExpr -> let condition = if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~customLayout ~braces:true ifExpr cmtTbl + printExpressionBlock ~state ~braces:true ifExpr cmtTbl else - let doc = - printExpressionWithComments ~customLayout ifExpr cmtTbl - in + let doc = printExpressionWithComments ~state ifExpr cmtTbl in match Parens.expr ifExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc ifExpr braces @@ -110664,14 +110616,12 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some _, expr -> expr | _ -> thenExpr in - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl); + printExpressionBlock ~state ~braces:true thenExpr cmtTbl); ] | IfLet (pattern, conditionExpr) -> let conditionDoc = let doc = - printExpressionWithComments ~customLayout conditionExpr - cmtTbl + printExpressionWithComments ~state conditionExpr cmtTbl in match Parens.expr conditionExpr with | Parens.Parenthesized -> addParens doc @@ -110682,12 +110632,11 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = [ ifTxt; Doc.text "let "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " = "; conditionDoc; Doc.space; - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl; + printExpressionBlock ~state ~braces:true thenExpr cmtTbl; ] in printLeadingComments doc cmtTbl.leading outerLoc) @@ -110699,14 +110648,13 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some expr -> Doc.concat [ - Doc.text " else "; - printExpressionBlock ~customLayout ~braces:true expr cmtTbl; + Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; ] in let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] -and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = +and printExpression ~state (e : Parsetree.expression) cmtTbl = let printArrow ~isUncurried e = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = @@ -110730,8 +110678,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | None -> false in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl + printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async + ~hasConstraint parameters cmtTbl in let returnExprDoc = let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in @@ -110753,7 +110701,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | _ -> true in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -110769,13 +110717,13 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match typConstraint with | Some typ -> let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if Parens.arrowReturnTypExpr typ then addParens doc else doc in Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in Doc.group (Doc.concat [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) @@ -110785,7 +110733,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Parsetree.Pexp_constant c -> printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment ~customLayout e cmtTbl + printJsxFragment ~state e cmtTbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat @@ -110800,9 +110748,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -110823,8 +110769,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -110850,7 +110795,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -110870,8 +110815,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -110885,7 +110829,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -110922,8 +110866,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -110952,8 +110895,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -110978,7 +110920,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -110998,8 +110940,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -111013,7 +110954,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -111041,7 +110982,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout + printExpressionWithComments ~state (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e @@ -111061,9 +111002,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111099,7 +111038,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - printExpressionRecordRow ~customLayout row cmtTbl + printExpressionRecordRow ~state row cmtTbl punningAllowed) rows); ]); @@ -111135,31 +111074,29 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printBsObjectRow ~customLayout row cmtTbl) + (fun row -> printBsObjectRow ~state row cmtTbl) rows); ]); Doc.trailingComma; Doc.softLine; Doc.rbrace; ]) - | extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl) + | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl) | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) when ParsetreeViewer.isSpreadBeltListConcat e -> - printBeltListConcatApply ~customLayout subLists cmtTbl + printBeltListConcatApply ~state subLists cmtTbl | Pexp_apply _ -> if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression ~customLayout e cmtTbl + printUnaryExpression ~state e cmtTbl else if ParsetreeViewer.isTemplateLiteral e then - printTemplateLiteral ~customLayout e cmtTbl + printTemplateLiteral ~state e cmtTbl else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression ~customLayout e cmtTbl - else printPexpApply ~customLayout e cmtTbl + printBinaryExpression ~state e cmtTbl + else printPexpApply ~state e cmtTbl | Pexp_unreachable -> Doc.dot | Pexp_field (expr, longidentLoc) -> let lhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.fieldExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111167,7 +111104,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [lhs; Doc.dot; printLidentPath longidentLoc cmtTbl] | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr ~customLayout e.pexp_attributes expr1 longidentLoc expr2 + printSetFieldExpr ~state e.pexp_attributes expr1 longidentLoc expr2 e.pexp_loc cmtTbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) when ParsetreeViewer.isTernaryExpr e -> @@ -111178,7 +111115,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printTernaryOperand ~customLayout condition1 cmtTbl; + printTernaryOperand ~state condition1 cmtTbl; Doc.indent (Doc.concat [ @@ -111187,8 +111124,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.text "? "; - printTernaryOperand ~customLayout consequent1 - cmtTbl; + printTernaryOperand ~state consequent1 cmtTbl; ]); Doc.concat (List.map @@ -111197,18 +111133,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = [ Doc.line; Doc.text ": "; - printTernaryOperand ~customLayout condition - cmtTbl; + printTernaryOperand ~state condition cmtTbl; Doc.line; Doc.text "? "; - printTernaryOperand ~customLayout consequent - cmtTbl; + printTernaryOperand ~state consequent cmtTbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent - (printTernaryOperand ~customLayout alternate cmtTbl); + Doc.indent (printTernaryOperand ~state alternate cmtTbl); ]); ]) | _ -> Doc.nil @@ -111221,15 +111154,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens ternaryDoc else ternaryDoc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments ~customLayout expr1 cmtTbl in + let doc = printExpressionWithComments ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -111242,32 +111175,28 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (if ParsetreeViewer.isBlockExpr expr1 then condition else Doc.group (Doc.ifBreaks (addParens condition) condition)); Doc.space; - printExpressionBlock ~customLayout ~braces:true expr2 cmtTbl; + printExpressionBlock ~state ~braces:true expr2 cmtTbl; ]) | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "for "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " in "; - (let doc = - printExpressionWithComments ~customLayout fromExpr cmtTbl - in + (let doc = printExpressionWithComments ~state fromExpr cmtTbl in match Parens.expr fromExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc fromExpr braces | Nothing -> doc); printDirectionFlag directionFlag; - (let doc = - printExpressionWithComments ~customLayout toExpr cmtTbl - in + (let doc = printExpressionWithComments ~state toExpr cmtTbl in match Parens.expr toExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc toExpr braces | Nothing -> doc); Doc.space; - printExpressionBlock ~customLayout ~braces:true body cmtTbl; + printExpressionBlock ~state ~braces:true body cmtTbl; ]) | Pexp_constraint ( {pexp_desc = Pexp_pack modExpr}, @@ -111280,10 +111209,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.softLine; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; printComments - (printPackageType ~customLayout + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; ]); @@ -111292,20 +111221,20 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ]) | Pexp_constraint (expr, typ) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_assert expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111314,7 +111243,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [Doc.text "assert "; rhs] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111322,24 +111251,22 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_pack modExpr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat - [Doc.softLine; printModExpr ~customLayout modExpr cmtTbl]); + (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); Doc.softLine; Doc.rparen; ]) - | Pexp_sequence _ -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl + | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_try (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111350,43 +111277,37 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text "try "; exprDoc; Doc.text " catch "; - printCases ~customLayout cases cmtTbl; + printCases ~state cases cmtTbl; ] | Pexp_match (_, [_; _]) when ParsetreeViewer.isIfLetExpr e -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_match (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat - [ - Doc.text "switch "; - exprDoc; - Doc.space; - printCases ~customLayout cases cmtTbl; - ] + [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] | Pexp_function cases -> - Doc.concat - [Doc.text "x => switch x "; printCases ~customLayout cases cmtTbl] + Doc.concat [Doc.text "x => switch x "; printCases ~state cases cmtTbl] | Pexp_coerce (expr, typOpt, typ) -> - let docExpr = printExpressionWithComments ~customLayout expr cmtTbl in - let docTyp = printTypExpr ~customLayout typ cmtTbl in + let docExpr = printExpressionWithComments ~state expr cmtTbl in + let docTyp = printTypExpr ~state typ cmtTbl in let ofType = match typOpt with | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ1 cmtTbl] + Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] in Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] | Pexp_send (parentExpr, label) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -111438,11 +111359,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match e.pexp_attributes with | [] -> exprWithAwait | attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprWithAwait]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) | _ -> exprWithAwait -and printPexpFun ~customLayout ~inCallback e cmtTbl = +and printPexpFun ~state ~inCallback e cmtTbl = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = ParsetreeViewer.processFunctionAttributes attrsOnArrow @@ -111459,7 +111379,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> (returnExpr, None) in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback ~async ~uncurried + printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint: (match typConstraint with | Some _ -> true @@ -111486,7 +111406,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> false in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -111507,36 +111427,35 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = in let typConstraintDoc = match typConstraint with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | _ -> Doc.nil in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc; ] -and printTernaryOperand ~customLayout expr cmtTbl = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in +and printTernaryOperand ~state expr cmtTbl = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.ternaryOperand expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc -and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = +and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl = let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.setFieldExprRhs rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces | Nothing -> doc in let lhsDoc = - let doc = printExpressionWithComments ~customLayout lhs cmtTbl in + let doc = printExpressionWithComments ~state lhs cmtTbl in match Parens.fieldExpr lhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc lhs braces @@ -111559,12 +111478,11 @@ and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = let doc = match attrs with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in printComments doc cmtTbl loc -and printTemplateLiteral ~customLayout expr cmtTbl = +and printTemplateLiteral ~state expr cmtTbl = let tag = ref "js" in let rec walkExpr expr = let open Parsetree in @@ -111579,7 +111497,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = tag := prefix; printStringContents txt | _ -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in let content = walkExpr expr in @@ -111591,7 +111509,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = Doc.text "`"; ] -and printUnaryExpression ~customLayout expr cmtTbl = +and printUnaryExpression ~state expr cmtTbl = let printUnaryOperator op = Doc.text (match op with @@ -111607,7 +111525,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> let printedOperand = - let doc = printExpressionWithComments ~customLayout operand cmtTbl in + let doc = printExpressionWithComments ~state operand cmtTbl in match Parens.unaryExprOperand operand with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc operand braces @@ -111617,7 +111535,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = printComments doc cmtTbl expr.pexp_loc | _ -> assert false -and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = +and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with @@ -111664,7 +111582,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = right.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {right with pexp_attributes = rightInternalAttrs} cmtTbl in @@ -111675,10 +111593,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = in let doc = Doc.concat - [ - printAttributes ~customLayout rightPrinteableAttrs cmtTbl; - doc; - ] + [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] in match rightPrinteableAttrs with | [] -> doc @@ -111723,7 +111638,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {expr with pexp_attributes = internalAttrs} cmtTbl in @@ -111736,8 +111651,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat - [printAttributes ~customLayout printeableAttrs cmtTbl; doc] + Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -111745,19 +111659,19 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = printTemplateLiteral ~customLayout expr cmtTbl in + let doc = printTemplateLiteral ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - printSetFieldExpr ~customLayout expr.pexp_attributes lhs field rhs + printSetFieldExpr ~state expr.pexp_attributes lhs field rhs expr.pexp_loc cmtTbl in if isLhs then addParens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments ~customLayout rhs cmtTbl in - let lhsDoc = printExpressionWithComments ~customLayout lhs cmtTbl in + let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in + let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in (* TODO: unify indentation of "=" *) let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = @@ -111775,12 +111689,11 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in if isLhs then addParens doc else doc | _ -> ( - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.binaryExprOperand ~isLhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111795,15 +111708,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = when not (ParsetreeViewer.isBinaryExpression lhs || ParsetreeViewer.isBinaryExpression rhs - || printAttributes ~customLayout expr.pexp_attributes cmtTbl - <> Doc.nil) -> + || printAttributes ~state expr.pexp_attributes cmtTbl <> Doc.nil) -> let lhsHasCommentBelow = hasCommentBelow cmtTbl lhs.pexp_loc in let lhsDoc = printOperand ~isLhs:true lhs op in let rhsDoc = printOperand ~isLhs:false rhs op in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] @@ -111837,7 +111749,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; (match Parens.binaryExpr { @@ -111853,14 +111765,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ]) | _ -> Doc.nil -and printBeltListConcatApply ~customLayout subLists cmtTbl = +and printBeltListConcatApply ~state subLists cmtTbl = let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ commaBeforeSpread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111881,9 +111793,7 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -111911,13 +111821,13 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ]) (* callExpr(arg1, arg2) *) -and printPexpApply ~customLayout expr cmtTbl = +and printPexpApply ~state expr cmtTbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -111928,14 +111838,14 @@ and printPexpApply ~customLayout expr cmtTbl = match memberExpr.pexp_desc with | Pexp_ident lident -> printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments ~customLayout memberExpr cmtTbl + | _ -> printExpressionWithComments ~state memberExpr cmtTbl in Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -111945,7 +111855,7 @@ and printPexpApply ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.expr rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces @@ -111960,7 +111870,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printExpressionWithComments ~customLayout lhs cmtTbl; + printExpressionWithComments ~state lhs cmtTbl; Doc.text " ="; (if shouldIndent then Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) @@ -111969,8 +111879,8 @@ and printPexpApply ~customLayout expr cmtTbl = in match expr.pexp_attributes with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc])) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) @@ -111978,7 +111888,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -111995,7 +111905,7 @@ and printPexpApply ~customLayout expr cmtTbl = [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -112004,7 +111914,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -112016,7 +111926,7 @@ and printPexpApply ~customLayout expr cmtTbl = -> let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -112050,14 +111960,14 @@ and printPexpApply ~customLayout expr cmtTbl = || ParsetreeViewer.isArrayAccess e in let targetExpr = - let doc = printExpressionWithComments ~customLayout targetExpr cmtTbl in + let doc = printExpressionWithComments ~state targetExpr cmtTbl in match Parens.expr targetExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc targetExpr braces | Nothing -> doc in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -112066,7 +111976,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -112079,7 +111989,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression ~customLayout lident args cmtTbl + printJsxExpression ~state lident args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map @@ -112090,7 +112000,7 @@ and printPexpApply ~customLayout expr cmtTbl = ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes in let callExprDoc = - let doc = printExpressionWithComments ~customLayout callExpr cmtTbl in + let doc = printExpressionWithComments ~state callExpr cmtTbl in match Parens.callExpr callExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc callExpr braces @@ -112098,15 +112008,12 @@ and printPexpApply ~customLayout expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -112128,19 +112035,18 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.concat [ maybeBreakParent; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc; ] else - let argsDoc = printArguments ~customLayout ~uncurried args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + let argsDoc = printArguments ~state ~uncurried args cmtTbl in + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false -and printJsxExpression ~customLayout lident args cmtTbl = +and printJsxExpression ~state lident args cmtTbl = let name = printJsxName lident in - let formattedProps, children = printJsxProps ~customLayout args cmtTbl in + let formattedProps, children = printJsxProps ~state args cmtTbl in (*
*) let hasChildren = match children with @@ -112179,8 +112085,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = Doc.line; (match children with | Some childrenExpression -> - printJsxChildren ~customLayout childrenExpression ~sep:lineSep - cmtTbl + printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl | None -> Doc.nil); ]); lineSep; @@ -112236,7 +112141,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = ]); ]) -and printJsxFragment ~customLayout expr cmtTbl = +and printJsxFragment ~state expr cmtTbl = let opening = Doc.text "<>" in let closing = Doc.text "" in let lineSep = @@ -112251,16 +112156,12 @@ and printJsxFragment ~customLayout expr cmtTbl = | _ -> Doc.indent (Doc.concat - [ - Doc.line; - printJsxChildren ~customLayout expr ~sep:lineSep cmtTbl; - ])); + [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); lineSep; closing; ]) -and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep - cmtTbl = +and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = match childrenExpr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in @@ -112271,9 +112172,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let addParensOrBraces exprDoc = (* {(20: int)} make sure that we also protect the expression inside *) let innerDoc = @@ -112292,9 +112191,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout childrenExpr cmtTbl - in + let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in Doc.concat [ Doc.dotdotdot; @@ -112309,8 +112206,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep | Nothing -> exprDoc); ] -and printJsxProps ~customLayout args cmtTbl : - Doc.t * Parsetree.expression option = +and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = (* This function was introduced because we have different formatting behavior for self-closing tags and other tags we always put /> on a new line for self-closing tag when it breaks expr.pexp_loc in let trailingCommentsPresent = hasTrailingComments cmtTbl loc in - let propDoc = printJsxProp ~customLayout lastProp cmtTbl in + let propDoc = printJsxProp ~state lastProp cmtTbl in let formattedProps = Doc.concat [ @@ -112382,12 +112278,12 @@ and printJsxProps ~customLayout args cmtTbl : in (formattedProps, Some children) | arg :: args -> - let propDoc = printJsxProp ~customLayout arg cmtTbl in + let propDoc = printJsxProp ~state arg cmtTbl in loop (propDoc :: props) args in loop [] args -and printJsxProp ~customLayout arg cmtTbl = +and printJsxProp ~state arg cmtTbl = match arg with | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { @@ -112413,7 +112309,7 @@ and printJsxProp ~customLayout arg cmtTbl = | Labelled _lbl -> printIdentLike ident | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; Doc.softLine; doc; Doc.rbrace] | lbl, expr -> let argLoc, expr = @@ -112436,7 +112332,7 @@ and printJsxProp ~customLayout arg cmtTbl = let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.jsxPropExpr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) @@ -112466,12 +112362,11 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = State.nextCustomLayout state in let cmtTblCopy = CommentTable.copy cmtTbl in let callback, printedArgs = match args with @@ -112486,17 +112381,14 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args in let callback = Doc.concat - [ - lblDoc; - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl; - ] + [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] in let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in let printedArgs = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~customLayout arg cmtTbl) args)) + (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) in (callback, printedArgs) | _ -> assert false @@ -112527,9 +112419,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * arg3, * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -112546,16 +112436,15 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = state |> State.nextCustomLayout in let cmtTblCopy = CommentTable.copy cmtTbl in let cmtTblCopy2 = CommentTable.copy cmtTbl in let rec loop acc args = @@ -112573,7 +112462,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl + printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl in let doc = Doc.concat [lblDoc; pexpFunDoc] in printComments doc cmtTbl expr.pexp_loc) @@ -112581,7 +112470,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackArgumentsFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:ArgumentsFitOnOneLine expr + printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr cmtTblCopy in let doc = Doc.concat [lblDoc; pexpFunDoc] in @@ -112591,7 +112480,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args callbackFitsOnOneLine, callbackArgumentsFitsOnOneLine ) | arg :: args -> - let argDoc = printArgument ~customLayout arg cmtTbl in + let argDoc = printArgument ~state arg cmtTbl in loop (Doc.line :: Doc.comma :: argDoc :: acc) args in let printedArgs, callback, callback2 = loop [] args in @@ -112630,9 +112519,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy2) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -112649,7 +112536,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout @@ -112659,7 +112546,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args Lazy.force breakAllArgs; ] -and printArguments ~customLayout ~uncurried +and printArguments ~state ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -112678,7 +112565,7 @@ and printArguments ~customLayout ~uncurried | _ -> Doc.text "()") | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -112697,9 +112584,7 @@ and printArguments ~customLayout ~uncurried (if uncurried then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> printArgument ~customLayout arg cmtTbl) - args); + (List.map (fun arg -> printArgument ~state arg cmtTbl) args); ]); Doc.trailingComma; Doc.softLine; @@ -112720,7 +112605,7 @@ and printArguments ~customLayout ~uncurried * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and printArgument ~customLayout (argLbl, arg) cmtTbl = +and printArgument ~state (argLbl, arg) cmtTbl = match (argLbl, arg) with (* ~a (punned)*) | ( Asttypes.Labelled lbl, @@ -112760,7 +112645,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = Doc.tilde; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in printComments doc cmtTbl loc @@ -112798,7 +112683,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = printComments doc cmtTbl argLoc in let printedExpr = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -112808,7 +112693,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = let doc = Doc.concat [printedLbl; printedExpr] in printComments doc cmtTbl loc -and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = +and printCases ~state (cases : Parsetree.case list) cmtTbl = Doc.breakableGroup ~forceBreak:true (Doc.concat [ @@ -112822,22 +112707,22 @@ and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = n.Parsetree.pc_lhs.ppat_loc with loc_end = n.pc_rhs.pexp_loc.loc_end; }) - ~print:(printCase ~customLayout) ~nodes:cases cmtTbl; + ~print:(printCase ~state) ~nodes:cases cmtTbl; ]; Doc.line; Doc.rbrace; ]) -and printCase ~customLayout (case : Parsetree.case) cmtTbl = +and printCase ~state (case : Parsetree.case) cmtTbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~customLayout + printExpressionBlock ~state ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) case.pc_rhs cmtTbl | _ -> ( - let doc = printExpressionWithComments ~customLayout case.pc_rhs cmtTbl in + let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in match Parens.expr case.pc_rhs with | Parenthesized -> addParens doc | _ -> doc) @@ -112852,7 +112737,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ]) in let shouldInlineRhs = @@ -112869,7 +112754,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = | _ -> true in let patternDoc = - let doc = printPattern ~customLayout case.pc_lhs cmtTbl in + let doc = printPattern ~state case.pc_lhs cmtTbl in match case.pc_lhs.ppat_desc with | Ppat_constraint _ -> addParens doc | _ -> doc @@ -112886,8 +112771,8 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = in Doc.group (Doc.concat [Doc.text "| "; content]) -and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried - ~hasConstraint parameters cmtTbl = +and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint + parameters cmtTbl = match parameters with (* let f = _ => () *) | [ @@ -112926,7 +112811,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried match attrs with | [] -> if hasConstraint then addParens var else var | attrs -> - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in addParens (Doc.concat [attrs; var]) in if async then addAsync var else var @@ -112968,7 +112853,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> printExpFunParameter ~customLayout p cmtTbl) + (fun p -> printExpFunParameter ~state p cmtTbl) parameters); ] in @@ -112983,13 +112868,13 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.rparen; ]) -and printExpFunParameter ~customLayout parameter cmtTbl = +and printExpFunParameter ~state parameter cmtTbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.text "type "; Doc.join ~sep:Doc.space (List.map @@ -113004,27 +112889,27 @@ and printExpFunParameter ~customLayout parameter cmtTbl = let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = match defaultExpr with | Some expr -> Doc.concat - [Doc.text "="; printExpressionWithComments ~customLayout expr cmtTbl] + [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) let labelWithPattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> printPattern ~customLayout pattern cmtTbl + | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl | ( (Asttypes.Labelled lbl | Optional lbl), {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) when lbl = stringLoc.txt -> (* ~d *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; ] @@ -113037,11 +112922,11 @@ and printExpFunParameter ~customLayout parameter cmtTbl = (* ~d: e *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) @@ -113050,7 +112935,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = Doc.text "~"; printIdentLike lbl; Doc.text " as "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; ] in let optionalLabelSuffix = @@ -113090,7 +112975,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = in printComments doc cmtTbl cmtLoc -and printExpressionBlock ~customLayout ~braces expr cmtTbl = +and printExpressionBlock ~state ~braces expr cmtTbl = let rec collectRows acc expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> @@ -113104,7 +112989,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = Doc.text "module "; name; Doc.text " = "; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; ] in let loc = {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} in @@ -113121,7 +113006,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = {cmtLoc with loc_end = loc.loc_end} in let letExceptionDoc = - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl in collectRows ((loc, letExceptionDoc) :: acc) expr2 | Pexp_open (overrideFlag, longidentLoc, expr2) -> @@ -113138,7 +113023,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = collectRows ((loc, openDoc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> let exprDoc = - let doc = printExpression ~customLayout expr1 cmtTbl in + let doc = printExpression ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -113165,9 +113050,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl - in + let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in (* let () = { * let () = foo() * () @@ -113180,7 +113063,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | _ -> collectRows ((loc, letDoc) :: acc) expr2) | _ -> let exprDoc = - let doc = printExpression ~customLayout expr cmtTbl in + let doc = printExpression ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -113257,7 +113140,7 @@ and printDirectionFlag flag = | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = +and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group @@ -113267,7 +113150,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = (* print punned field *) Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; printOptionalLabel expr.pexp_attributes; printLidentPath lbl cmtTbl; ] @@ -113277,7 +113160,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = printLidentPath lbl cmtTbl; Doc.text ": "; printOptionalLabel expr.pexp_attributes; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.exprRecordRowRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -113286,7 +113169,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = in printComments doc cmtTbl cmtLoc -and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = +and printBsObjectRow ~state (lbl, expr) cmtTbl = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let lblDoc = let doc = @@ -113299,7 +113182,7 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = [ lblDoc; Doc.text ": "; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -113314,8 +113197,8 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and printAttributes ?loc ?(inline = false) ~customLayout - (attrs : Parsetree.attributes) cmtTbl = +and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmtTbl = match ParsetreeViewer.filterParsingAttrs attrs with | [] -> Doc.nil | attrs -> @@ -113333,17 +113216,15 @@ and printAttributes ?loc ?(inline = false) ~customLayout [ Doc.group (Doc.joinWithSep - (List.map - (fun attr -> printAttribute ~customLayout attr cmtTbl) - attrs)); + (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); (if inline then Doc.space else lineBreak); ] -and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = +and printPayload ~state (payload : Parsetree.payload) cmtTbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments ~customLayout expr cmtTbl in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let needsParens = match attrs with | [] -> false @@ -113354,7 +113235,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.concat [ Doc.lparen; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); Doc.rparen; ] @@ -113366,22 +113247,21 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = (Doc.concat [ Doc.softLine; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); ]); Doc.softLine; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - addParens (printStructureItem ~customLayout si cmtTbl) - | PStr structure -> addParens (printStructure ~customLayout structure cmtTbl) + addParens (printStructureItem ~state si cmtTbl) + | PStr structure -> addParens (printStructure ~state structure cmtTbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent - (Doc.concat [Doc.line; printTypExpr ~customLayout typ cmtTbl]); + Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); Doc.softLine; Doc.rparen; ] @@ -113393,7 +113273,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ] | None -> Doc.nil in @@ -113405,7 +113285,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.softLine; Doc.text "? "; - printPattern ~customLayout pat cmtTbl; + printPattern ~state pat cmtTbl; whenDoc; ]); Doc.softLine; @@ -113417,12 +113297,12 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.softLine; Doc.rparen; ] -and printAttribute ?(standalone = false) ~customLayout +and printAttribute ?(standalone = false) ~state ((id, payload) : Parsetree.attribute) cmtTbl = match (id, payload) with | ( {txt = "ns.doc"}, @@ -113446,11 +113326,11 @@ and printAttribute ?(standalone = false) ~customLayout [ Doc.text (if standalone then "@@" else "@"); Doc.text (convertBsExternalAttribute id.txt); - printPayload ~customLayout payload cmtTbl; + printPayload ~state payload cmtTbl; ]), Doc.line ) -and printModExpr ~customLayout modExpr cmtTbl = +and printModExpr ~state modExpr cmtTbl = let doc = match modExpr.pmod_desc with | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl @@ -113468,7 +113348,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.lbrace; Doc.indent (Doc.concat - [Doc.softLine; printStructure ~customLayout structure cmtTbl]); + [Doc.softLine; printStructure ~state structure cmtTbl]); Doc.softLine; Doc.rbrace; ]) @@ -113488,7 +113368,7 @@ and printModExpr ~customLayout modExpr cmtTbl = (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> let packageDoc = let doc = - printPackageType ~customLayout ~printModuleKeywordAndParens:false + printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl in printComments doc cmtTbl ptyp_loc @@ -113504,10 +113384,7 @@ and printModExpr ~customLayout modExpr cmtTbl = let unpackDoc = Doc.group (Doc.concat - [ - printExpressionWithComments ~customLayout expr cmtTbl; - moduleConstraint; - ]) + [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) in Doc.group (Doc.concat @@ -113523,7 +113400,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.rparen; ]) | Pmod_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmod_apply _ -> let args, callExpr = ParsetreeViewer.modExprApply modExpr in let isUnitSugar = @@ -113539,17 +113416,15 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.group (Doc.concat [ - printModExpr ~customLayout callExpr cmtTbl; + printModExpr ~state callExpr cmtTbl; (if isUnitSugar then - printModApplyArg ~customLayout - (List.hd args [@doesNotRaise]) - cmtTbl + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else Doc.concat [ Doc.lparen; (if shouldHug then - printModApplyArg ~customLayout + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else @@ -113561,7 +113436,7 @@ and printModExpr ~customLayout modExpr cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun modArg -> - printModApplyArg ~customLayout modArg cmtTbl) + printModApplyArg ~state modArg cmtTbl) args); ])); (if not shouldHug then @@ -113573,15 +113448,15 @@ and printModExpr ~customLayout modExpr cmtTbl = | Pmod_constraint (modExpr, modType) -> Doc.concat [ - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - printModType ~customLayout modType cmtTbl; + printModType ~state modType cmtTbl; ] - | Pmod_functor _ -> printModFunctor ~customLayout modExpr cmtTbl + | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl in printComments doc cmtTbl modExpr.pmod_loc -and printModFunctor ~customLayout modExpr cmtTbl = +and printModFunctor ~state modExpr cmtTbl = let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) @@ -113592,18 +113467,18 @@ and printModFunctor ~customLayout modExpr cmtTbl = match returnModExpr.pmod_desc with | Pmod_constraint (modExpr, modType) -> let constraintDoc = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modExprFunctorConstraint modType then addParens doc else doc in let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in - (modConstraint, printModExpr ~customLayout modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr ~customLayout returnModExpr cmtTbl) + (modConstraint, printModExpr ~state modExpr cmtTbl) + | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) in let parametersDoc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; Doc.text "()"]) + (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -113617,8 +113492,7 @@ and printModFunctor ~customLayout modExpr cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> - printModFunctorParam ~customLayout param cmtTbl) + (fun param -> printModFunctorParam ~state param cmtTbl) parameters); ]); Doc.trailingComma; @@ -113630,14 +113504,14 @@ and printModFunctor ~customLayout modExpr cmtTbl = (Doc.concat [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) -and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = +and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = let cmtLoc = match optModType with | None -> lbl.Asttypes.loc | Some modType -> {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let lblDoc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in printComments doc cmtTbl lbl.loc @@ -113651,19 +113525,17 @@ and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = (match optModType with | None -> Doc.nil | Some modType -> - Doc.concat - [Doc.text ": "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); ]) in printComments doc cmtTbl cmtLoc -and printModApplyArg ~customLayout modExpr cmtTbl = +and printModApplyArg ~state modExpr cmtTbl = match modExpr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr ~customLayout modExpr cmtTbl + | _ -> printModExpr ~state modExpr cmtTbl -and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) - cmtTbl = +and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = let kind = match constr.pext_kind with | Pext_rebind longident -> @@ -113674,15 +113546,11 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc @@ -113691,7 +113559,7 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) Doc.group (Doc.concat [ - printAttributes ~customLayout constr.pext_attributes cmtTbl; + printAttributes ~state constr.pext_attributes cmtTbl; Doc.text "exception "; name; kind; @@ -113699,9 +113567,9 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) in printComments doc cmtTbl constr.pext_loc -and printExtensionConstructor ~customLayout - (constr : Parsetree.extension_constructor) cmtTbl i = - let attrs = printAttributes ~customLayout constr.pext_attributes cmtTbl in +and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) + cmtTbl i = + let attrs = printAttributes ~state constr.pext_attributes cmtTbl in let bar = if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil in @@ -113715,40 +113583,36 @@ and printExtensionConstructor ~customLayout | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -let printTypeParams = printTypeParams ~customLayout:0 -let printTypExpr = printTypExpr ~customLayout:0 -let printExpression = printExpression ~customLayout:0 -let printPattern = printPattern ~customLayout:0 +let printTypeParams = printTypeParams ~state:State.init +let printTypExpr = printTypExpr ~state:State.init +let printExpression = printExpression ~state:State.init +let printPattern = printPattern ~state:State.init let printImplementation ~width (s : Parsetree.structure) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkStructure s cmtTbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure ~customLayout:0 s cmtTbl in + let doc = printStructure ~state:State.init s cmtTbl in (* Doc.debug doc; *) Doc.toString ~width doc ^ "\n" let printInterface ~width (s : Parsetree.signature) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkSignature s cmtTbl comments; - Doc.toString ~width (printSignature ~customLayout:0 s cmtTbl) ^ "\n" + Doc.toString ~width (printSignature ~state:State.init s cmtTbl) ^ "\n" -let printStructure = printStructure ~customLayout:0 +let printStructure = printStructure ~state:State.init end module Pattern_printer : sig diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 3dbc2e0588..aa3afb2004 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -572,19 +572,29 @@ let printOptionalLabel attrs = if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" else Doc.nil -let customLayoutThreshold = 2 +module State = struct + let customLayoutThreshold = 2 -let rec printStructure ~customLayout (s : Parsetree.structure) t = + type t = {customLayout: int; uncurried: bool} + + let init = {customLayout = 0; uncurried = false} + + let nextCustomLayout t = {t with customLayout = t.customLayout + 1} + + let shouldBreakCallback t = t.customLayout > customLayoutThreshold +end + +let rec printStructure ~state (s : Parsetree.structure) t = match s with | [] -> printCommentsInsideFile t | structure -> printList ~getLoc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(printStructureItem ~customLayout) + ~print:(printStructureItem ~state) t -and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = +and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = match si.pstr_desc with | Pstr_value (rec_flag, valueBindings) -> let recFlag = @@ -592,58 +602,56 @@ and printStructureItem ~customLayout (si : Parsetree.structure_item) cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl + printValueBindings ~state ~recFlag valueBindings cmtTbl | Pstr_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl | Pstr_primitive valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Pstr_eval (expr, attrs) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.structureExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] | Pstr_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Pstr_include includeDeclaration -> - printIncludeDeclaration ~customLayout includeDeclaration cmtTbl + printIncludeDeclaration ~state includeDeclaration cmtTbl | Pstr_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Pstr_module moduleBinding -> - printModuleBinding ~customLayout ~isRec:false moduleBinding cmtTbl 0 + printModuleBinding ~state ~isRec:false moduleBinding cmtTbl 0 | Pstr_recmodule moduleBindings -> printListi ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) ~nodes:moduleBindings - ~print:(printModuleBinding ~customLayout ~isRec:true) + ~print:(printModuleBinding ~state ~isRec:true) cmtTbl | Pstr_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl - | Pstr_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl + | Pstr_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil -and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = +and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = let prefix = Doc.text "type " in let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams ~customLayout te.ptyext_params cmtTbl in + let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in let extensionConstructors = let ecs = te.ptyext_constructors in let forceBreak = @@ -661,7 +669,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = let rows = printListi ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:(printExtensionConstructor ~customLayout) + ~print:(printExtensionConstructor ~state) ~nodes:ecs ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak @@ -679,8 +687,8 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout ~loc:te.ptyext_path.loc - te.ptyext_attributes cmtTbl; + printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmtTbl; prefix; name; typeParams; @@ -688,7 +696,7 @@ and printTypeExtension ~customLayout (te : Parsetree.type_extension) cmtTbl = extensionConstructors; ]) -and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = +and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = let prefix = if i = 0 then Doc.concat @@ -698,9 +706,9 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let modExprDoc, modConstraintDoc = match moduleBinding.pmb_expr with | {pmod_desc = Pmod_constraint (modExpr, modType)} -> - ( printModExpr ~customLayout modExpr cmtTbl, - Doc.concat [Doc.text ": "; printModType ~customLayout modType cmtTbl] ) - | modExpr -> (printModExpr ~customLayout modExpr cmtTbl, Doc.nil) + ( printModExpr ~state modExpr cmtTbl, + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] ) + | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil) in let modName = let doc = Doc.text moduleBinding.pmb_name.Location.txt in @@ -709,7 +717,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:moduleBinding.pmb_name.loc + printAttributes ~state ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes cmtTbl; prefix; modName; @@ -720,7 +728,7 @@ and printModuleBinding ~customLayout ~isRec moduleBinding cmtTbl i = in printComments doc cmtTbl moduleBinding.pmb_loc -and printModuleTypeDeclaration ~customLayout +and printModuleTypeDeclaration ~state (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = let modName = let doc = Doc.text modTypeDecl.pmtd_name.txt in @@ -728,23 +736,23 @@ and printModuleTypeDeclaration ~customLayout in Doc.concat [ - printAttributes ~customLayout modTypeDecl.pmtd_attributes cmtTbl; + printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; Doc.text "module type "; modName; (match modTypeDecl.pmtd_type with | None -> Doc.nil | Some modType -> - Doc.concat [Doc.text " = "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); ] -and printModType ~customLayout modType cmtTbl = +and printModType ~state modType cmtTbl = let modTypeDoc = match modType.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~customLayout ~loc:longident.loc - modType.pmty_attributes cmtTbl; + printAttributes ~state ~loc:longident.loc modType.pmty_attributes + cmtTbl; printLongidentLocation longident cmtTbl; ] | Pmty_signature [] -> @@ -765,17 +773,13 @@ and printModType ~customLayout modType cmtTbl = [ Doc.lbrace; Doc.indent - (Doc.concat - [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [ - printAttributes ~customLayout modType.pmty_attributes cmtTbl; - signatureDoc; - ] + [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] | Pmty_functor _ -> let parameters, returnType = ParsetreeViewer.functorType modType in let parametersDoc = @@ -785,10 +789,8 @@ and printModType ~customLayout modType cmtTbl = let cmtLoc = {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in - let doc = - Doc.concat [attrs; printModType ~customLayout modType cmtTbl] - in + let attrs = printAttributes ~state attrs cmtTbl in + let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in printComments doc cmtTbl cmtLoc | params -> Doc.group @@ -814,7 +816,7 @@ and printModType ~customLayout modType cmtTbl = } in let attrs = - printAttributes ~customLayout attrs cmtTbl + printAttributes ~state attrs cmtTbl in let lblDoc = if lbl.Location.txt = "_" || lbl.txt = "*" then @@ -835,8 +837,7 @@ and printModType ~customLayout modType cmtTbl = [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - printModType ~customLayout modType - cmtTbl; + printModType ~state modType cmtTbl; ]); ] in @@ -849,7 +850,7 @@ and printModType ~customLayout modType cmtTbl = ]) in let returnDoc = - let doc = printModType ~customLayout returnType cmtTbl in + let doc = printModType ~state returnType cmtTbl in if Parens.modTypeFunctorReturn returnType then addParens doc else doc in Doc.group @@ -860,14 +861,14 @@ and printModType ~customLayout modType cmtTbl = ]) | Pmty_typeof modExpr -> Doc.concat - [Doc.text "module type of "; printModExpr ~customLayout modExpr cmtTbl] + [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] | Pmty_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmty_alias longident -> Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] | Pmty_with (modType, withConstraints) -> let operand = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modTypeWithOperand modType then addParens doc else doc in Doc.group @@ -876,10 +877,7 @@ and printModType ~customLayout modType cmtTbl = operand; Doc.indent (Doc.concat - [ - Doc.line; - printWithConstraints ~customLayout withConstraints cmtTbl; - ]); + [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); ]) in let attrsAlreadyPrinted = @@ -891,13 +889,13 @@ and printModType ~customLayout modType cmtTbl = Doc.concat [ (if attrsAlreadyPrinted then Doc.nil - else printAttributes ~customLayout modType.pmty_attributes cmtTbl); + else printAttributes ~state modType.pmty_attributes cmtTbl); modTypeDoc; ] in printComments doc cmtTbl modType.pmty_loc -and printWithConstraints ~customLayout withConstraints cmtTbl = +and printWithConstraints ~state withConstraints cmtTbl = let rows = List.mapi (fun i withConstraint -> @@ -905,19 +903,19 @@ and printWithConstraints ~customLayout withConstraints cmtTbl = (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - printWithConstraint ~customLayout withConstraint cmtTbl; + printWithConstraint ~state withConstraint cmtTbl; ])) withConstraints in Doc.join ~sep:Doc.line rows -and printWithConstraint ~customLayout - (withConstraint : Parsetree.with_constraint) cmtTbl = +and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) + cmtTbl = match withConstraint with (* with type X.t = ... *) | Pwith_type (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) (* with module X.Y = Z *) @@ -932,7 +930,7 @@ and printWithConstraint ~customLayout (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_typesubst (longident, typeDeclaration) -> Doc.group - (printTypeDeclaration ~customLayout + (printTypeDeclaration ~state ~name:(printLidentPath longident cmtTbl) ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> @@ -944,60 +942,58 @@ and printWithConstraint ~customLayout Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] -and printSignature ~customLayout signature cmtTbl = +and printSignature ~state signature cmtTbl = match signature with | [] -> printCommentsInsideFile cmtTbl | signature -> printList ~getLoc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(printSignatureItem ~customLayout) + ~print:(printSignatureItem ~state) cmtTbl -and printSignatureItem ~customLayout (si : Parsetree.signature_item) cmtTbl = +and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = match si.psig_desc with | Parsetree.Psig_value valueDescription -> - printValueDescription ~customLayout valueDescription cmtTbl + printValueDescription ~state valueDescription cmtTbl | Psig_type (recFlag, typeDeclarations) -> let recFlag = match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl - | Psig_typext typeExtension -> - printTypeExtension ~customLayout typeExtension cmtTbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Psig_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Psig_exception extensionConstructor -> - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl | Psig_module moduleDeclaration -> - printModuleDeclaration ~customLayout moduleDeclaration cmtTbl + printModuleDeclaration ~state moduleDeclaration cmtTbl | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl + printRecModuleDeclarations ~state moduleDeclarations cmtTbl | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration ~customLayout modTypeDecl cmtTbl + printModuleTypeDeclaration ~state modTypeDecl cmtTbl | Psig_open openDescription -> - printOpenDescription ~customLayout openDescription cmtTbl + printOpenDescription ~state openDescription cmtTbl | Psig_include includeDescription -> - printIncludeDescription ~customLayout includeDescription cmtTbl + printIncludeDescription ~state includeDescription cmtTbl | Psig_attribute attr -> - fst (printAttribute ~customLayout ~standalone:true attr cmtTbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; - Doc.concat - [printExtension ~customLayout ~atModuleLvl:true extension cmtTbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and printRecModuleDeclarations ~customLayout moduleDeclarations cmtTbl = +and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.pmd_loc) ~nodes:moduleDeclarations - ~print:(printRecModuleDeclaration ~customLayout) + ~print:(printRecModuleDeclaration ~state) cmtTbl -and printRecModuleDeclaration ~customLayout md cmtTbl i = +and printRecModuleDeclaration ~state md cmtTbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> @@ -1009,7 +1005,7 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = | _ -> false in let modTypeDoc = - let doc = printModType ~customLayout md.pmd_type cmtTbl in + let doc = printModType ~state md.pmd_type cmtTbl in if needsParens then addParens doc else doc in Doc.concat [Doc.text ": "; modTypeDoc] @@ -1017,34 +1013,32 @@ and printRecModuleDeclaration ~customLayout md cmtTbl i = let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text prefix; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printModuleDeclaration ~customLayout (md : Parsetree.module_declaration) - cmtTbl = +and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> - Doc.concat [Doc.text ": "; printModType ~customLayout md.pmd_type cmtTbl] + | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] in Doc.concat [ - printAttributes ~customLayout ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text "module "; printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and printOpenDescription ~customLayout - (openDescription : Parsetree.open_description) cmtTbl = +and printOpenDescription ~state (openDescription : Parsetree.open_description) + cmtTbl = Doc.concat [ - printAttributes ~customLayout openDescription.popen_attributes cmtTbl; + printAttributes ~state openDescription.popen_attributes cmtTbl; Doc.text "open"; (match openDescription.popen_override with | Asttypes.Fresh -> Doc.space @@ -1052,45 +1046,45 @@ and printOpenDescription ~customLayout printLongidentLocation openDescription.popen_lid cmtTbl; ] -and printIncludeDescription ~customLayout +and printIncludeDescription ~state (includeDescription : Parsetree.include_description) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDescription.pincl_attributes cmtTbl; + printAttributes ~state includeDescription.pincl_attributes cmtTbl; Doc.text "include "; - printModType ~customLayout includeDescription.pincl_mod cmtTbl; + printModType ~state includeDescription.pincl_mod cmtTbl; ] -and printIncludeDeclaration ~customLayout +and printIncludeDeclaration ~state (includeDeclaration : Parsetree.include_declaration) cmtTbl = Doc.concat [ - printAttributes ~customLayout includeDeclaration.pincl_attributes cmtTbl; + printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; Doc.text "include "; (let includeDoc = - printModExpr ~customLayout includeDeclaration.pincl_mod cmtTbl + printModExpr ~state includeDeclaration.pincl_mod cmtTbl in if Parens.includeModExpr includeDeclaration.pincl_mod then addParens includeDoc else includeDoc); ] -and printValueBindings ~customLayout ~recFlag - (vbs : Parsetree.value_binding list) cmtTbl = +and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) + cmtTbl = printListi ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~customLayout ~recFlag) + ~print:(printValueBinding ~state ~recFlag) cmtTbl -and printValueDescription ~customLayout valueDescription cmtTbl = +and printValueDescription ~state valueDescription cmtTbl = let isExternal = match valueDescription.pval_prim with | [] -> false | _ -> true in let attrs = - printAttributes ~customLayout ~loc:valueDescription.pval_name.loc + printAttributes ~state ~loc:valueDescription.pval_name.loc valueDescription.pval_attributes cmtTbl in let header = if isExternal then "external " else "let " in @@ -1103,7 +1097,7 @@ and printValueDescription ~customLayout valueDescription cmtTbl = (printIdentLike valueDescription.pval_name.txt) cmtTbl valueDescription.pval_name.loc; Doc.text ": "; - printTypExpr ~customLayout valueDescription.pval_type cmtTbl; + printTypExpr ~state valueDescription.pval_type cmtTbl; (if isExternal then Doc.group (Doc.concat @@ -1124,11 +1118,11 @@ and printValueDescription ~customLayout valueDescription cmtTbl = else Doc.nil); ]) -and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = +and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = printListi ~getLoc:(fun n -> n.Parsetree.ptype_loc) ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~customLayout ~recFlag) + ~print:(printTypeDeclaration2 ~state ~recFlag) cmtTbl (* @@ -1163,16 +1157,16 @@ and printTypeDeclarations ~customLayout ~recFlag typeDeclarations cmtTbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i +and printTypeDeclaration ~state ~name ~equalSign ~recFlag i (td : Parsetree.type_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -1183,7 +1177,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -1200,7 +1194,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -1208,7 +1202,7 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -1218,39 +1212,37 @@ and printTypeDeclaration ~customLayout ~name ~equalSign ~recFlag i Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDeclaration2 ~customLayout ~recFlag - (td : Parsetree.type_declaration) cmtTbl i = +and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) + cmtTbl i = let name = let doc = printIdentLike td.Parsetree.ptype_name.txt in printComments doc cmtTbl td.ptype_name.loc in let equalSign = "=" in let attrs = - printAttributes ~customLayout ~loc:td.ptype_loc td.ptype_attributes cmtTbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in let typeName = name in - let typeParams = printTypeParams ~customLayout td.ptype_params cmtTbl in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( @@ -1261,7 +1253,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat @@ -1289,7 +1281,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat @@ -1297,7 +1289,7 @@ and printTypeDeclaration2 ~customLayout ~recFlag manifest; Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; printPrivateFlag td.ptype_private; - printRecordDeclaration ~customLayout lds cmtTbl; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -1307,25 +1299,23 @@ and printTypeDeclaration2 ~customLayout ~recFlag Doc.concat [ Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~customLayout - ~privateFlag:td.ptype_private cds cmtTbl; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = - printTypeDefinitionConstraints ~customLayout td.ptype_cstrs - in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and printTypeDefinitionConstraints ~customLayout cstrs = +and printTypeDefinitionConstraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -1336,20 +1326,18 @@ and printTypeDefinitionConstraints ~customLayout cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map - (printTypeDefinitionConstraint ~customLayout) - cstrs)); + (List.map (printTypeDefinitionConstraint ~state) cstrs)); ])) -and printTypeDefinitionConstraint ~customLayout +and printTypeDefinitionConstraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr ~customLayout typ1 CommentTable.empty; + printTypExpr ~state typ1 CommentTable.empty; Doc.text " = "; - printTypExpr ~customLayout typ2 CommentTable.empty; + printTypExpr ~state typ2 CommentTable.empty; ] and printPrivateFlag (flag : Asttypes.private_flag) = @@ -1357,7 +1345,7 @@ and printPrivateFlag (flag : Asttypes.private_flag) = | Private -> Doc.text "private " | Public -> Doc.nil -and printTypeParams ~customLayout typeParams cmtTbl = +and printTypeParams ~state typeParams cmtTbl = match typeParams with | [] -> Doc.nil | typeParams -> @@ -1373,9 +1361,7 @@ and printTypeParams ~customLayout typeParams cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun typeParam -> - let doc = - printTypeParam ~customLayout typeParam cmtTbl - in + let doc = printTypeParam ~state typeParam cmtTbl in printComments doc cmtTbl (fst typeParam).Parsetree.ptyp_loc) typeParams); @@ -1385,8 +1371,8 @@ and printTypeParams ~customLayout typeParams cmtTbl = Doc.greaterThan; ]) -and printTypeParam ~customLayout - (param : Parsetree.core_type * Asttypes.variance) cmtTbl = +and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) + cmtTbl = let typ, variance = param in let printedVariance = match variance with @@ -1394,10 +1380,10 @@ and printTypeParam ~customLayout | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printedVariance; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] -and printRecordDeclaration ~customLayout - (lds : Parsetree.label_declaration list) cmtTbl = +and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) + cmtTbl = let forceBreak = match (lds, List.rev lds) with | first :: _, last :: _ -> @@ -1416,9 +1402,7 @@ and printRecordDeclaration ~customLayout ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -1427,7 +1411,7 @@ and printRecordDeclaration ~customLayout Doc.rbrace; ]) -and printConstructorDeclarations ~customLayout ~privateFlag +and printConstructorDeclarations ~state ~privateFlag (cds : Parsetree.constructor_declaration list) cmtTbl = let forceBreak = match (cds, List.rev cds) with @@ -1445,16 +1429,16 @@ and printConstructorDeclarations ~customLayout ~privateFlag ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds ~print:(fun cd cmtTbl i -> - let doc = printConstructorDeclaration2 ~customLayout i cd cmtTbl in + let doc = printConstructorDeclaration2 ~state i cd cmtTbl in printComments doc cmtTbl cd.Parsetree.pcd_loc) ~forceBreak cmtTbl in Doc.breakableGroup ~forceBreak (Doc.indent (Doc.concat [Doc.line; privateFlag; rows])) -and printConstructorDeclaration2 ~customLayout i +and printConstructorDeclaration2 ~state i (cd : Parsetree.constructor_declaration) cmtTbl = - let attrs = printAttributes ~customLayout cd.pcd_attributes cmtTbl in + let attrs = printAttributes ~state cd.pcd_attributes cmtTbl in let bar = if i > 0 || cd.pcd_attributes <> [] then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil @@ -1464,14 +1448,13 @@ and printConstructorDeclaration2 ~customLayout i printComments doc cmtTbl cd.pcd_name.loc in let constrArgs = - printConstructorArguments ~customLayout ~indent:true cd.pcd_args cmtTbl + printConstructorArguments ~state ~indent:true cd.pcd_args cmtTbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent - (Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl]) + Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) in Doc.concat [ @@ -1487,7 +1470,7 @@ and printConstructorDeclaration2 ~customLayout i ]); ] -and printConstructorArguments ~customLayout ~indent +and printConstructorArguments ~state ~indent (cdArgs : Parsetree.constructor_arguments) cmtTbl = match cdArgs with | Pcstr_tuple [] -> Doc.nil @@ -1503,7 +1486,7 @@ and printConstructorArguments ~customLayout ~indent Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -1527,9 +1510,7 @@ and printConstructorArguments ~customLayout ~indent ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = - printLabelDeclaration ~customLayout ld cmtTbl - in + let doc = printLabelDeclaration ~state ld cmtTbl in printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); @@ -1541,10 +1522,9 @@ and printConstructorArguments ~customLayout ~indent in if indent then Doc.indent args else args -and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) - cmtTbl = +and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = let attrs = - printAttributes ~customLayout ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl + printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl in let mutableFlag = match ld.pld_mutable with @@ -1564,10 +1544,10 @@ and printLabelDeclaration ~customLayout (ld : Parsetree.label_declaration) name; optional; Doc.text ": "; - printTypExpr ~customLayout ld.pld_type cmtTbl; + printTypExpr ~state ld.pld_type cmtTbl; ]) -and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = +and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = @@ -1583,7 +1563,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | _ -> false in let returnDoc = - let doc = printTypExpr ~customLayout returnType cmtTbl in + let doc = printTypExpr ~state returnType cmtTbl in if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in @@ -1593,11 +1573,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl + printAttributes ~state ~inline:true attrsBefore cmtTbl else Doc.nil in let typDoc = - let doc = printTypExpr ~customLayout n cmtTbl in + let doc = printTypExpr ~state n cmtTbl in match n.ptyp_desc with | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc | _ -> doc @@ -1620,9 +1600,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = else Doc.concat [typDoc; Doc.text " => "; returnDoc]); ]) | args -> - let attrs = - printAttributes ~customLayout ~inline:true attrsBefore cmtTbl - in + let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in let renderedArgs = Doc.concat [ @@ -1637,7 +1615,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun tp -> printTypeParameter ~customLayout tp cmtTbl) + (fun tp -> printTypeParameter ~state tp cmtTbl) args); ]); Doc.trailingComma; @@ -1653,7 +1631,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_var var -> Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] | Ptyp_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Ptyp_alias (typ, alias) -> let typ = (* Technically type t = (string, float) => unit as 'x, doesn't require @@ -1665,14 +1643,14 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] (* object printings *) | Ptyp_object (fields, openFlag) -> - printObject ~customLayout ~inline:false fields openFlag cmtTbl + printObject ~state ~inline:false fields openFlag cmtTbl | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in @@ -1692,7 +1670,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printObject ~customLayout ~inline:true fields openFlag cmtTbl; + printObject ~state ~inline:true fields openFlag cmtTbl; Doc.greaterThan; ] | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> @@ -1702,7 +1680,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = [ constrName; Doc.lessThan; - printTupleType ~customLayout ~inline:true tuple cmtTbl; + printTupleType ~state ~inline:true tuple cmtTbl; Doc.greaterThan; ]) | Ptyp_constr (longidentLoc, constrArgs) -> ( @@ -1722,17 +1700,15 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> - printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) constrArgs); ]); Doc.trailingComma; Doc.softLine; Doc.greaterThan; ])) - | Ptyp_tuple types -> - printTupleType ~customLayout ~inline:false types cmtTbl - | Ptyp_poly ([], typ) -> printTypExpr ~customLayout typ cmtTbl + | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl + | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl | Ptyp_poly (stringLocs, typ) -> Doc.concat [ @@ -1744,11 +1720,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = stringLocs); Doc.dot; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | Ptyp_package packageType -> - printPackageType ~customLayout ~printModuleKeywordAndParens:true - packageType cmtTbl + printPackageType ~state ~printModuleKeywordAndParens:true packageType + cmtTbl | Ptyp_class _ -> Doc.text "classes are not supported in types" | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> let forceBreak = @@ -1761,7 +1737,7 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; ]) in @@ -1769,10 +1745,9 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = | Rtag ({txt}, attrs, truth, types) -> let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr ~customLayout t cmtTbl + | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl | _ -> - Doc.concat - [Doc.lparen; printTypExpr ~customLayout t cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] in let printedTypes = List.map doType types in let cases = @@ -1784,11 +1759,11 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.concat [Doc.text "#"; printPolyVarIdent txt]; cases; ]) - | Rinherit coreType -> printTypExpr ~customLayout coreType cmtTbl + | Rinherit coreType -> printTypExpr ~state coreType cmtTbl in let docs = List.map printRowField rowFields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in @@ -1834,13 +1809,12 @@ and printTypExpr ~customLayout (typExpr : Parsetree.core_type) cmtTbl = let doc = match typExpr.ptyp_attributes with | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; renderedType]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) | _ -> renderedType in printComments doc cmtTbl typExpr.ptyp_loc -and printObject ~customLayout ~inline fields openFlag cmtTbl = +and printObject ~state ~inline fields openFlag cmtTbl = let doc = match fields with | [] -> @@ -1871,7 +1845,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> printObjectField ~customLayout field cmtTbl) + (fun field -> printObjectField ~state field cmtTbl) fields); ]); Doc.trailingComma; @@ -1881,8 +1855,7 @@ and printObject ~customLayout ~inline fields openFlag cmtTbl = in if inline then doc else Doc.group doc -and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) - cmtTbl = +and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = let tuple = Doc.concat [ @@ -1894,7 +1867,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~customLayout typexpr cmtTbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); Doc.trailingComma; @@ -1904,7 +1877,7 @@ and printTupleType ~customLayout ~inline (types : Parsetree.core_type list) in if inline == false then Doc.group tuple else tuple -and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = +and printObjectField ~state (field : Parsetree.object_field) cmtTbl = match field with | Otag (labelLoc, attrs, typ) -> let lbl = @@ -1914,27 +1887,27 @@ and printObjectField ~customLayout (field : Parsetree.object_field) cmtTbl = let doc = Doc.concat [ - printAttributes ~customLayout ~loc:labelLoc.loc attrs cmtTbl; + printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in printComments doc cmtTbl cmtLoc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; printTypExpr ~customLayout typexpr cmtTbl] + Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = +and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with | Asttypes.Nolabel -> Doc.nil @@ -1962,17 +1935,15 @@ and printTypeParameter ~customLayout (attrs, lbl, typ) cmtTbl = uncurried; attrs; label; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; optionalIndicator; ]) in printComments doc cmtTbl loc -and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) - cmtTbl i = +and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = let attrs = - printAttributes ~customLayout ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes - cmtTbl + printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl in let header = if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " @@ -2006,7 +1977,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -2014,13 +1985,10 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ]) | _ -> @@ -2033,7 +2001,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) [ attrs; header; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat @@ -2041,25 +2009,22 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) Doc.line; abstractType; Doc.space; - printTypExpr ~customLayout patTyp cmtTbl; + printTypExpr ~state patTyp cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - printExpressionWithComments ~customLayout expr cmtTbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ])) | _ -> let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in let printedExpr = - let doc = printExpressionWithComments ~customLayout vb.pvb_expr cmtTbl in + let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in match Parens.expr vb.pvb_expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let patternDoc = printPattern ~customLayout vb.pvb_pat cmtTbl in + let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -2121,7 +2086,7 @@ and printValueBinding ~customLayout ~recFlag (vb : Parsetree.value_binding) else Doc.concat [Doc.space; printedExpr]); ]) -and printPackageType ~customLayout ~printModuleKeywordAndParens +and printPackageType ~state ~printModuleKeywordAndParens (packageType : Parsetree.package_type) cmtTbl = let doc = match packageType with @@ -2132,7 +2097,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens (Doc.concat [ printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints ~customLayout packageConstraints cmtTbl; + printPackageConstraints ~state packageConstraints cmtTbl; Doc.softLine; ]) in @@ -2140,7 +2105,7 @@ and printPackageType ~customLayout ~printModuleKeywordAndParens Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and printPackageConstraints ~customLayout packageConstraints cmtTbl = +and printPackageConstraints ~state packageConstraints cmtTbl = Doc.concat [ Doc.text " with"; @@ -2158,25 +2123,23 @@ and printPackageConstraints ~customLayout packageConstraints cmtTbl = loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = - printPackageConstraint ~customLayout i cmtTbl pc - in + let doc = printPackageConstraint ~state i cmtTbl pc in printComments doc cmtTbl cmtLoc) packageConstraints); ]); ] -and printPackageConstraint ~customLayout i cmtTbl (longidentLoc, typ) = +and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; printLongidentLocation longidentLoc cmtTbl; Doc.text " = "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] -and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = +and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = let txt = convertBsExtension stringLoc.Location.txt in let extName = let doc = @@ -2189,9 +2152,9 @@ and printExtension ~customLayout ~atModuleLvl (stringLoc, payload) cmtTbl = in printComments doc cmtTbl stringLoc.Location.loc in - Doc.group (Doc.concat [extName; printPayload ~customLayout payload cmtTbl]) + Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) -and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = +and printPattern ~state (p : Parsetree.pattern) cmtTbl = let patternWithoutAttributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" @@ -2213,7 +2176,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -2235,7 +2198,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -2264,15 +2227,12 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = (if shouldHug then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) - patterns); + (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat - [Doc.text "..."; printPattern ~customLayout tail cmtTbl] + Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] in let tail = printComments doc cmtTbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); @@ -2308,8 +2268,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2321,7 +2280,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -2329,7 +2288,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -2360,8 +2319,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat - [Doc.lparen; printPattern ~customLayout arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2373,7 +2331,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~customLayout pat cmtTbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); Doc.trailingComma; @@ -2381,7 +2339,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~customLayout arg cmtTbl in + let argDoc = printPattern ~state arg cmtTbl in let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ @@ -2412,8 +2370,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printPatternRecordRow ~customLayout row cmtTbl) + (fun row -> printPatternRecordRow ~state row cmtTbl) rows); (match openFlag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] @@ -2430,7 +2387,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.group (Doc.concat [Doc.text "exception"; Doc.line; pat]) @@ -2440,7 +2397,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = let docs = List.mapi (fun i pat -> - let patternDoc = printPattern ~customLayout pat cmtTbl in + let patternDoc = printPattern ~state pat cmtTbl in Doc.concat [ (if i == 0 then Doc.nil @@ -2459,8 +2416,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) - | Ppat_extension ext -> - printExtension ~customLayout ~atModuleLvl:false ext cmtTbl + | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> let needsParens = match p.ppat_desc with @@ -2468,7 +2424,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let pat = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] @@ -2479,7 +2435,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | _ -> false in let renderedPattern = - let p = printPattern ~customLayout p cmtTbl in + let p = printPattern ~state p cmtTbl in if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat @@ -2495,7 +2451,7 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.text ": "; printComments - (printPackageType ~customLayout ~printModuleKeywordAndParens:false + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; Doc.rparen; @@ -2503,9 +2459,9 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) @@ -2526,13 +2482,11 @@ and printPattern ~customLayout (p : Parsetree.pattern) cmtTbl = | attrs -> Doc.group (Doc.concat - [ - printAttributes ~customLayout attrs cmtTbl; patternWithoutAttributes; - ]) + [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) in printComments doc cmtTbl p.ppat_loc -and printPatternRecordRow ~customLayout row cmtTbl = +and printPatternRecordRow ~state row cmtTbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -2541,7 +2495,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = Doc.concat [ printOptionalLabel ppat_attributes; - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; printLidentPath longident cmtTbl; ] | longident, pattern -> @@ -2549,7 +2503,7 @@ and printPatternRecordRow ~customLayout row cmtTbl = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in let rhsDoc = - let doc = printPattern ~customLayout pattern cmtTbl in + let doc = printPattern ~state pattern cmtTbl in let doc = if Parens.patternRecordRowRhs pattern then addParens doc else doc in @@ -2568,11 +2522,11 @@ and printPatternRecordRow ~customLayout row cmtTbl = in printComments doc cmtTbl locForComments -and printExpressionWithComments ~customLayout expr cmtTbl : Doc.t = - let doc = printExpression ~customLayout expr cmtTbl in +and printExpressionWithComments ~state expr cmtTbl : Doc.t = + let doc = printExpression ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc -and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = +and printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = let ifDocs = Doc.join ~sep:Doc.space (List.mapi @@ -2583,11 +2537,9 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | ParsetreeViewer.If ifExpr -> let condition = if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~customLayout ~braces:true ifExpr cmtTbl + printExpressionBlock ~state ~braces:true ifExpr cmtTbl else - let doc = - printExpressionWithComments ~customLayout ifExpr cmtTbl - in + let doc = printExpressionWithComments ~state ifExpr cmtTbl in match Parens.expr ifExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc ifExpr braces @@ -2604,14 +2556,12 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some _, expr -> expr | _ -> thenExpr in - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl); + printExpressionBlock ~state ~braces:true thenExpr cmtTbl); ] | IfLet (pattern, conditionExpr) -> let conditionDoc = let doc = - printExpressionWithComments ~customLayout conditionExpr - cmtTbl + printExpressionWithComments ~state conditionExpr cmtTbl in match Parens.expr conditionExpr with | Parens.Parenthesized -> addParens doc @@ -2622,12 +2572,11 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = [ ifTxt; Doc.text "let "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " = "; conditionDoc; Doc.space; - printExpressionBlock ~customLayout ~braces:true thenExpr - cmtTbl; + printExpressionBlock ~state ~braces:true thenExpr cmtTbl; ] in printLeadingComments doc cmtTbl.leading outerLoc) @@ -2639,14 +2588,13 @@ and printIfChain ~customLayout pexp_attributes ifs elseExpr cmtTbl = | Some expr -> Doc.concat [ - Doc.text " else "; - printExpressionBlock ~customLayout ~braces:true expr cmtTbl; + Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; ] in let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in - Doc.concat [printAttributes ~customLayout attrs cmtTbl; ifDocs; elseDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] -and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = +and printExpression ~state (e : Parsetree.expression) cmtTbl = let printArrow ~isUncurried e = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = @@ -2670,8 +2618,8 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | None -> false in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback:NoCallback ~uncurried - ~async ~hasConstraint parameters cmtTbl + printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async + ~hasConstraint parameters cmtTbl in let returnExprDoc = let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in @@ -2693,7 +2641,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | _ -> true in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -2709,13 +2657,13 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match typConstraint with | Some typ -> let typDoc = - let doc = printTypExpr ~customLayout typ cmtTbl in + let doc = printTypExpr ~state typ cmtTbl in if Parens.arrowReturnTypExpr typ then addParens doc else doc in Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in Doc.group (Doc.concat [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) @@ -2725,7 +2673,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = | Parsetree.Pexp_constant c -> printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment ~customLayout e cmtTbl + printJsxFragment ~state e cmtTbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat @@ -2740,9 +2688,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -2763,8 +2709,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -2790,7 +2735,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -2810,8 +2755,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -2825,7 +2769,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -2862,8 +2806,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -2892,8 +2835,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -2918,7 +2860,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~customLayout arg cmtTbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -2938,8 +2880,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (List.map (fun expr -> let doc = - printExpressionWithComments ~customLayout expr - cmtTbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc @@ -2953,7 +2894,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ] | Some arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -2981,7 +2922,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~customLayout + printExpressionWithComments ~state (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl | Pexp_fun _ | Pexp_newtype _ -> printArrow ~isUncurried:false e @@ -3001,9 +2942,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.dotdotdot; - (let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3039,7 +2978,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - printExpressionRecordRow ~customLayout row cmtTbl + printExpressionRecordRow ~state row cmtTbl punningAllowed) rows); ]); @@ -3075,31 +3014,29 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - printBsObjectRow ~customLayout row cmtTbl) + (fun row -> printBsObjectRow ~state row cmtTbl) rows); ]); Doc.trailingComma; Doc.softLine; Doc.rbrace; ]) - | extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl) + | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl) | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) when ParsetreeViewer.isSpreadBeltListConcat e -> - printBeltListConcatApply ~customLayout subLists cmtTbl + printBeltListConcatApply ~state subLists cmtTbl | Pexp_apply _ -> if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression ~customLayout e cmtTbl + printUnaryExpression ~state e cmtTbl else if ParsetreeViewer.isTemplateLiteral e then - printTemplateLiteral ~customLayout e cmtTbl + printTemplateLiteral ~state e cmtTbl else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression ~customLayout e cmtTbl - else printPexpApply ~customLayout e cmtTbl + printBinaryExpression ~state e cmtTbl + else printPexpApply ~state e cmtTbl | Pexp_unreachable -> Doc.dot | Pexp_field (expr, longidentLoc) -> let lhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.fieldExpr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3107,7 +3044,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [lhs; Doc.dot; printLidentPath longidentLoc cmtTbl] | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr ~customLayout e.pexp_attributes expr1 longidentLoc expr2 + printSetFieldExpr ~state e.pexp_attributes expr1 longidentLoc expr2 e.pexp_loc cmtTbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) when ParsetreeViewer.isTernaryExpr e -> @@ -3118,7 +3055,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printTernaryOperand ~customLayout condition1 cmtTbl; + printTernaryOperand ~state condition1 cmtTbl; Doc.indent (Doc.concat [ @@ -3127,8 +3064,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.text "? "; - printTernaryOperand ~customLayout consequent1 - cmtTbl; + printTernaryOperand ~state consequent1 cmtTbl; ]); Doc.concat (List.map @@ -3137,18 +3073,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = [ Doc.line; Doc.text ": "; - printTernaryOperand ~customLayout condition - cmtTbl; + printTernaryOperand ~state condition cmtTbl; Doc.line; Doc.text "? "; - printTernaryOperand ~customLayout consequent - cmtTbl; + printTernaryOperand ~state consequent cmtTbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent - (printTernaryOperand ~customLayout alternate cmtTbl); + Doc.indent (printTernaryOperand ~state alternate cmtTbl); ]); ]) | _ -> Doc.nil @@ -3161,15 +3094,15 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens ternaryDoc else ternaryDoc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments ~customLayout expr1 cmtTbl in + let doc = printExpressionWithComments ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -3182,32 +3115,28 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (if ParsetreeViewer.isBlockExpr expr1 then condition else Doc.group (Doc.ifBreaks (addParens condition) condition)); Doc.space; - printExpressionBlock ~customLayout ~braces:true expr2 cmtTbl; + printExpressionBlock ~state ~braces:true expr2 cmtTbl; ]) | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "for "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; Doc.text " in "; - (let doc = - printExpressionWithComments ~customLayout fromExpr cmtTbl - in + (let doc = printExpressionWithComments ~state fromExpr cmtTbl in match Parens.expr fromExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc fromExpr braces | Nothing -> doc); printDirectionFlag directionFlag; - (let doc = - printExpressionWithComments ~customLayout toExpr cmtTbl - in + (let doc = printExpressionWithComments ~state toExpr cmtTbl in match Parens.expr toExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc toExpr braces | Nothing -> doc); Doc.space; - printExpressionBlock ~customLayout ~braces:true body cmtTbl; + printExpressionBlock ~state ~braces:true body cmtTbl; ]) | Pexp_constraint ( {pexp_desc = Pexp_pack modExpr}, @@ -3220,10 +3149,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.softLine; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; printComments - (printPackageType ~customLayout + (printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl) cmtTbl ptyp_loc; ]); @@ -3232,20 +3161,20 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = ]) | Pexp_constraint (expr, typ) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_assert expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3254,7 +3183,7 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.concat [Doc.text "assert "; rhs] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.lazyOrAssertOrAwaitExprRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3262,24 +3191,22 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_pack modExpr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat - [Doc.softLine; printModExpr ~customLayout modExpr cmtTbl]); + (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); Doc.softLine; Doc.rparen; ]) - | Pexp_sequence _ -> - printExpressionBlock ~customLayout ~braces:true e cmtTbl - | Pexp_let _ -> printExpressionBlock ~customLayout ~braces:true e cmtTbl + | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_try (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3290,43 +3217,37 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = Doc.text "try "; exprDoc; Doc.text " catch "; - printCases ~customLayout cases cmtTbl; + printCases ~state cases cmtTbl; ] | Pexp_match (_, [_; _]) when ParsetreeViewer.isIfLetExpr e -> let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~customLayout e.pexp_attributes ifs elseExpr cmtTbl + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_match (expr, cases) -> let exprDoc = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat - [ - Doc.text "switch "; - exprDoc; - Doc.space; - printCases ~customLayout cases cmtTbl; - ] + [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] | Pexp_function cases -> - Doc.concat - [Doc.text "x => switch x "; printCases ~customLayout cases cmtTbl] + Doc.concat [Doc.text "x => switch x "; printCases ~state cases cmtTbl] | Pexp_coerce (expr, typOpt, typ) -> - let docExpr = printExpressionWithComments ~customLayout expr cmtTbl in - let docTyp = printTypExpr ~customLayout typ cmtTbl in + let docExpr = printExpressionWithComments ~state expr cmtTbl in + let docTyp = printTypExpr ~state typ cmtTbl in let ofType = match typOpt with | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ1 cmtTbl] + Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] in Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] | Pexp_send (parentExpr, label) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -3378,11 +3299,10 @@ and printExpression ~customLayout (e : Parsetree.expression) cmtTbl = match e.pexp_attributes with | [] -> exprWithAwait | attrs when not shouldPrintItsOwnAttributes -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; exprWithAwait]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) | _ -> exprWithAwait -and printPexpFun ~customLayout ~inCallback e cmtTbl = +and printPexpFun ~state ~inCallback e cmtTbl = let attrsOnArrow, parameters, returnExpr = ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; uncurried; attributes = attrs} = ParsetreeViewer.processFunctionAttributes attrsOnArrow @@ -3399,7 +3319,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> (returnExpr, None) in let parametersDoc = - printExprFunParameters ~customLayout ~inCallback ~async ~uncurried + printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint: (match typConstraint with | Some _ -> true @@ -3426,7 +3346,7 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = | _ -> false in let returnDoc = - let doc = printExpressionWithComments ~customLayout returnExpr cmtTbl in + let doc = printExpressionWithComments ~state returnExpr cmtTbl in match Parens.expr returnExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc returnExpr braces @@ -3447,36 +3367,35 @@ and printPexpFun ~customLayout ~inCallback e cmtTbl = in let typConstraintDoc = match typConstraint with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | _ -> Doc.nil in Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc; ] -and printTernaryOperand ~customLayout expr cmtTbl = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in +and printTernaryOperand ~state expr cmtTbl = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.ternaryOperand expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces | Nothing -> doc -and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = +and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl = let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.setFieldExprRhs rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces | Nothing -> doc in let lhsDoc = - let doc = printExpressionWithComments ~customLayout lhs cmtTbl in + let doc = printExpressionWithComments ~state lhs cmtTbl in match Parens.fieldExpr lhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc lhs braces @@ -3499,12 +3418,11 @@ and printSetFieldExpr ~customLayout attrs lhs longidentLoc rhs loc cmtTbl = let doc = match attrs with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in printComments doc cmtTbl loc -and printTemplateLiteral ~customLayout expr cmtTbl = +and printTemplateLiteral ~state expr cmtTbl = let tag = ref "js" in let rec walkExpr expr = let open Parsetree in @@ -3519,7 +3437,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = tag := prefix; printStringContents txt | _ -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in let content = walkExpr expr in @@ -3531,7 +3449,7 @@ and printTemplateLiteral ~customLayout expr cmtTbl = Doc.text "`"; ] -and printUnaryExpression ~customLayout expr cmtTbl = +and printUnaryExpression ~state expr cmtTbl = let printUnaryOperator op = Doc.text (match op with @@ -3547,7 +3465,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> let printedOperand = - let doc = printExpressionWithComments ~customLayout operand cmtTbl in + let doc = printExpressionWithComments ~state operand cmtTbl in match Parens.unaryExprOperand operand with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc operand braces @@ -3557,7 +3475,7 @@ and printUnaryExpression ~customLayout expr cmtTbl = printComments doc cmtTbl expr.pexp_loc | _ -> assert false -and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = +and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = let printBinaryOperator ~inlineRhs operator = let operatorTxt = match operator with @@ -3604,7 +3522,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = right.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {right with pexp_attributes = rightInternalAttrs} cmtTbl in @@ -3615,10 +3533,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = in let doc = Doc.concat - [ - printAttributes ~customLayout rightPrinteableAttrs cmtTbl; - doc; - ] + [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] in match rightPrinteableAttrs with | [] -> doc @@ -3663,7 +3578,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes in let doc = - printExpressionWithComments ~customLayout + printExpressionWithComments ~state {expr with pexp_attributes = internalAttrs} cmtTbl in @@ -3676,8 +3591,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat - [printAttributes ~customLayout printeableAttrs cmtTbl; doc] + Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -3685,19 +3599,19 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = printTemplateLiteral ~customLayout expr cmtTbl in + let doc = printTemplateLiteral ~state expr cmtTbl in printComments doc cmtTbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - printSetFieldExpr ~customLayout expr.pexp_attributes lhs field rhs + printSetFieldExpr ~state expr.pexp_attributes lhs field rhs expr.pexp_loc cmtTbl in if isLhs then addParens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments ~customLayout rhs cmtTbl in - let lhsDoc = printExpressionWithComments ~customLayout lhs cmtTbl in + let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in + let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in (* TODO: unify indentation of "=" *) let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = @@ -3715,12 +3629,11 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in if isLhs then addParens doc else doc | _ -> ( - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.binaryExprOperand ~isLhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3735,15 +3648,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = when not (ParsetreeViewer.isBinaryExpression lhs || ParsetreeViewer.isBinaryExpression rhs - || printAttributes ~customLayout expr.pexp_attributes cmtTbl - <> Doc.nil) -> + || printAttributes ~state expr.pexp_attributes cmtTbl <> Doc.nil) -> let lhsHasCommentBelow = hasCommentBelow cmtTbl lhs.pexp_loc in let lhsDoc = printOperand ~isLhs:true lhs op in let rhsDoc = printOperand ~isLhs:false rhs op in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; lhsDoc; (match (lhsHasCommentBelow, op) with | true, "|." -> Doc.concat [Doc.softLine; Doc.text "->"] @@ -3777,7 +3689,7 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; (match Parens.binaryExpr { @@ -3793,14 +3705,14 @@ and printBinaryExpression ~customLayout (expr : Parsetree.expression) cmtTbl = ]) | _ -> Doc.nil -and printBeltListConcatApply ~customLayout subLists cmtTbl = +and printBeltListConcatApply ~state subLists cmtTbl = let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ commaBeforeSpread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3821,9 +3733,7 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -3851,13 +3761,13 @@ and printBeltListConcatApply ~customLayout subLists cmtTbl = ]) (* callExpr(arg1, arg2) *) -and printPexpApply ~customLayout expr cmtTbl = +and printPexpApply ~state expr cmtTbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -3868,14 +3778,14 @@ and printPexpApply ~customLayout expr cmtTbl = match memberExpr.pexp_desc with | Pexp_ident lident -> printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments ~customLayout memberExpr cmtTbl + | _ -> printExpressionWithComments ~state memberExpr cmtTbl in Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -3885,7 +3795,7 @@ and printPexpApply ~customLayout expr cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( let rhsDoc = - let doc = printExpressionWithComments ~customLayout rhs cmtTbl in + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.expr rhs with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc rhs braces @@ -3900,7 +3810,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printExpressionWithComments ~customLayout lhs cmtTbl; + printExpressionWithComments ~state lhs cmtTbl; Doc.text " ="; (if shouldIndent then Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) @@ -3909,8 +3819,8 @@ and printPexpApply ~customLayout expr cmtTbl = in match expr.pexp_attributes with | [] -> doc - | attrs -> - Doc.group (Doc.concat [printAttributes ~customLayout attrs cmtTbl; doc])) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) @@ -3918,7 +3828,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -3935,7 +3845,7 @@ and printPexpApply ~customLayout expr cmtTbl = [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -3944,7 +3854,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -3956,7 +3866,7 @@ and printPexpApply ~customLayout expr cmtTbl = -> let member = let memberDoc = - let doc = printExpressionWithComments ~customLayout memberExpr cmtTbl in + let doc = printExpressionWithComments ~state memberExpr cmtTbl in match Parens.expr memberExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc memberExpr braces @@ -3990,14 +3900,14 @@ and printPexpApply ~customLayout expr cmtTbl = || ParsetreeViewer.isArrayAccess e in let targetExpr = - let doc = printExpressionWithComments ~customLayout targetExpr cmtTbl in + let doc = printExpressionWithComments ~state targetExpr cmtTbl in match Parens.expr targetExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc targetExpr braces | Nothing -> doc in let parentDoc = - let doc = printExpressionWithComments ~customLayout parentExpr cmtTbl in + let doc = printExpressionWithComments ~state parentExpr cmtTbl in match Parens.unaryExprOperand parentExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc parentExpr braces @@ -4006,7 +3916,7 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.group (Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; parentDoc; Doc.lbracket; member; @@ -4019,7 +3929,7 @@ and printPexpApply ~customLayout expr cmtTbl = (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression ~customLayout lident args cmtTbl + printJsxExpression ~state lident args cmtTbl | Pexp_apply (callExpr, args) -> let args = List.map @@ -4030,7 +3940,7 @@ and printPexpApply ~customLayout expr cmtTbl = ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes in let callExprDoc = - let doc = printExpressionWithComments ~customLayout callExpr cmtTbl in + let doc = printExpressionWithComments ~state callExpr cmtTbl in match Parens.callExpr callExpr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc callExpr braces @@ -4038,15 +3948,12 @@ and printPexpApply ~customLayout expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -4068,19 +3975,18 @@ and printPexpApply ~customLayout expr cmtTbl = Doc.concat [ maybeBreakParent; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc; ] else - let argsDoc = printArguments ~customLayout ~uncurried args cmtTbl in - Doc.concat - [printAttributes ~customLayout attrs cmtTbl; callExprDoc; argsDoc] + let argsDoc = printArguments ~state ~uncurried args cmtTbl in + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false -and printJsxExpression ~customLayout lident args cmtTbl = +and printJsxExpression ~state lident args cmtTbl = let name = printJsxName lident in - let formattedProps, children = printJsxProps ~customLayout args cmtTbl in + let formattedProps, children = printJsxProps ~state args cmtTbl in (*
*) let hasChildren = match children with @@ -4119,8 +4025,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = Doc.line; (match children with | Some childrenExpression -> - printJsxChildren ~customLayout childrenExpression ~sep:lineSep - cmtTbl + printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl | None -> Doc.nil); ]); lineSep; @@ -4176,7 +4081,7 @@ and printJsxExpression ~customLayout lident args cmtTbl = ]); ]) -and printJsxFragment ~customLayout expr cmtTbl = +and printJsxFragment ~state expr cmtTbl = let opening = Doc.text "<>" in let closing = Doc.text "" in let lineSep = @@ -4191,16 +4096,12 @@ and printJsxFragment ~customLayout expr cmtTbl = | _ -> Doc.indent (Doc.concat - [ - Doc.line; - printJsxChildren ~customLayout expr ~sep:lineSep cmtTbl; - ])); + [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); lineSep; closing; ]) -and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep - cmtTbl = +and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = match childrenExpr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in @@ -4211,9 +4112,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout expr cmtTbl - in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let addParensOrBraces exprDoc = (* {(20: int)} make sure that we also protect the expression inside *) let innerDoc = @@ -4232,9 +4131,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep let leadingLineCommentPresent = hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in - let exprDoc = - printExpressionWithComments ~customLayout childrenExpr cmtTbl - in + let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in Doc.concat [ Doc.dotdotdot; @@ -4249,8 +4146,7 @@ and printJsxChildren ~customLayout (childrenExpr : Parsetree.expression) ~sep | Nothing -> exprDoc); ] -and printJsxProps ~customLayout args cmtTbl : - Doc.t * Parsetree.expression option = +and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = (* This function was introduced because we have different formatting behavior for self-closing tags and other tags we always put /> on a new line for self-closing tag when it breaks expr.pexp_loc in let trailingCommentsPresent = hasTrailingComments cmtTbl loc in - let propDoc = printJsxProp ~customLayout lastProp cmtTbl in + let propDoc = printJsxProp ~state lastProp cmtTbl in let formattedProps = Doc.concat [ @@ -4322,12 +4218,12 @@ and printJsxProps ~customLayout args cmtTbl : in (formattedProps, Some children) | arg :: args -> - let propDoc = printJsxProp ~customLayout arg cmtTbl in + let propDoc = printJsxProp ~state arg cmtTbl in loop (propDoc :: props) args in loop [] args -and printJsxProp ~customLayout arg cmtTbl = +and printJsxProp ~state arg cmtTbl = match arg with | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { @@ -4353,7 +4249,7 @@ and printJsxProp ~customLayout arg cmtTbl = | Labelled _lbl -> printIdentLike ident | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; Doc.softLine; doc; Doc.rbrace] | lbl, expr -> let argLoc, expr = @@ -4376,7 +4272,7 @@ and printJsxProp ~customLayout arg cmtTbl = let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.jsxPropExpr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) @@ -4406,12 +4302,11 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args - cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = State.nextCustomLayout state in let cmtTblCopy = CommentTable.copy cmtTbl in let callback, printedArgs = match args with @@ -4426,17 +4321,14 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args in let callback = Doc.concat - [ - lblDoc; - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl; - ] + [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] in let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in let printedArgs = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~customLayout arg cmtTbl) args)) + (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) in (callback, printedArgs) | _ -> assert false @@ -4467,9 +4359,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * arg3, * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4486,16 +4376,15 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~customLayout args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args - cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let customLayout = customLayout + 1 in + let state = state |> State.nextCustomLayout in let cmtTblCopy = CommentTable.copy cmtTbl in let cmtTblCopy2 = CommentTable.copy cmtTbl in let rec loop acc args = @@ -4513,7 +4402,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:FitsOnOneLine expr cmtTbl + printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl in let doc = Doc.concat [lblDoc; pexpFunDoc] in printComments doc cmtTbl expr.pexp_loc) @@ -4521,7 +4410,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args let callbackArgumentsFitsOnOneLine = lazy (let pexpFunDoc = - printPexpFun ~customLayout ~inCallback:ArgumentsFitOnOneLine expr + printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr cmtTblCopy in let doc = Doc.concat [lblDoc; pexpFunDoc] in @@ -4531,7 +4420,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args callbackFitsOnOneLine, callbackArgumentsFitsOnOneLine ) | arg :: args -> - let argDoc = printArgument ~customLayout arg cmtTbl in + let argDoc = printArgument ~state arg cmtTbl in loop (Doc.line :: Doc.comma :: argDoc :: acc) args in let printedArgs, callback, callback2 = loop [] args in @@ -4570,9 +4459,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = - lazy (printArguments ~customLayout ~uncurried args cmtTblCopy2) - in + let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4589,7 +4476,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if customLayout > customLayoutThreshold then Lazy.force breakAllArgs + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout @@ -4599,7 +4486,7 @@ and printArgumentsWithCallbackInLastPosition ~customLayout ~uncurried args Lazy.force breakAllArgs; ] -and printArguments ~customLayout ~uncurried +and printArguments ~state ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -4618,7 +4505,7 @@ and printArguments ~customLayout ~uncurried | _ -> Doc.text "()") | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> let argDoc = - let doc = printExpressionWithComments ~customLayout arg cmtTbl in + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc arg braces @@ -4637,9 +4524,7 @@ and printArguments ~customLayout ~uncurried (if uncurried then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> printArgument ~customLayout arg cmtTbl) - args); + (List.map (fun arg -> printArgument ~state arg cmtTbl) args); ]); Doc.trailingComma; Doc.softLine; @@ -4660,7 +4545,7 @@ and printArguments ~customLayout ~uncurried * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and printArgument ~customLayout (argLbl, arg) cmtTbl = +and printArgument ~state (argLbl, arg) cmtTbl = match (argLbl, arg) with (* ~a (punned)*) | ( Asttypes.Labelled lbl, @@ -4700,7 +4585,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = Doc.tilde; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] in printComments doc cmtTbl loc @@ -4738,7 +4623,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = printComments doc cmtTbl argLoc in let printedExpr = - let doc = printExpressionWithComments ~customLayout expr cmtTbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -4748,7 +4633,7 @@ and printArgument ~customLayout (argLbl, arg) cmtTbl = let doc = Doc.concat [printedLbl; printedExpr] in printComments doc cmtTbl loc -and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = +and printCases ~state (cases : Parsetree.case list) cmtTbl = Doc.breakableGroup ~forceBreak:true (Doc.concat [ @@ -4762,22 +4647,22 @@ and printCases ~customLayout (cases : Parsetree.case list) cmtTbl = n.Parsetree.pc_lhs.ppat_loc with loc_end = n.pc_rhs.pexp_loc.loc_end; }) - ~print:(printCase ~customLayout) ~nodes:cases cmtTbl; + ~print:(printCase ~state) ~nodes:cases cmtTbl; ]; Doc.line; Doc.rbrace; ]) -and printCase ~customLayout (case : Parsetree.case) cmtTbl = +and printCase ~state (case : Parsetree.case) cmtTbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~customLayout + printExpressionBlock ~state ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) case.pc_rhs cmtTbl | _ -> ( - let doc = printExpressionWithComments ~customLayout case.pc_rhs cmtTbl in + let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in match Parens.expr case.pc_rhs with | Parenthesized -> addParens doc | _ -> doc) @@ -4792,7 +4677,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ]) in let shouldInlineRhs = @@ -4809,7 +4694,7 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = | _ -> true in let patternDoc = - let doc = printPattern ~customLayout case.pc_lhs cmtTbl in + let doc = printPattern ~state case.pc_lhs cmtTbl in match case.pc_lhs.ppat_desc with | Ppat_constraint _ -> addParens doc | _ -> doc @@ -4826,8 +4711,8 @@ and printCase ~customLayout (case : Parsetree.case) cmtTbl = in Doc.group (Doc.concat [Doc.text "| "; content]) -and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried - ~hasConstraint parameters cmtTbl = +and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint + parameters cmtTbl = match parameters with (* let f = _ => () *) | [ @@ -4866,7 +4751,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried match attrs with | [] -> if hasConstraint then addParens var else var | attrs -> - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in addParens (Doc.concat [attrs; var]) in if async then addAsync var else var @@ -4908,7 +4793,7 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> printExpFunParameter ~customLayout p cmtTbl) + (fun p -> printExpFunParameter ~state p cmtTbl) parameters); ] in @@ -4923,13 +4808,13 @@ and printExprFunParameters ~customLayout ~inCallback ~async ~uncurried Doc.rparen; ]) -and printExpFunParameter ~customLayout parameter cmtTbl = +and printExpFunParameter ~state parameter cmtTbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; Doc.text "type "; Doc.join ~sep:Doc.space (List.map @@ -4944,27 +4829,27 @@ and printExpFunParameter ~customLayout parameter cmtTbl = let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = match defaultExpr with | Some expr -> Doc.concat - [Doc.text "="; printExpressionWithComments ~customLayout expr cmtTbl] + [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) let labelWithPattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> printPattern ~customLayout pattern cmtTbl + | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl | ( (Asttypes.Labelled lbl | Optional lbl), {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) when lbl = stringLoc.txt -> (* ~d *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; ] @@ -4977,11 +4862,11 @@ and printExpFunParameter ~customLayout parameter cmtTbl = (* ~d: e *) Doc.concat [ - printAttributes ~customLayout ppat_attributes cmtTbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; printIdentLike lbl; Doc.text ": "; - printTypExpr ~customLayout typ cmtTbl; + printTypExpr ~state typ cmtTbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) @@ -4990,7 +4875,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = Doc.text "~"; printIdentLike lbl; Doc.text " as "; - printPattern ~customLayout pattern cmtTbl; + printPattern ~state pattern cmtTbl; ] in let optionalLabelSuffix = @@ -5030,7 +4915,7 @@ and printExpFunParameter ~customLayout parameter cmtTbl = in printComments doc cmtTbl cmtLoc -and printExpressionBlock ~customLayout ~braces expr cmtTbl = +and printExpressionBlock ~state ~braces expr cmtTbl = let rec collectRows acc expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> @@ -5044,7 +4929,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = Doc.text "module "; name; Doc.text " = "; - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; ] in let loc = {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} in @@ -5061,7 +4946,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = {cmtLoc with loc_end = loc.loc_end} in let letExceptionDoc = - printExceptionDef ~customLayout extensionConstructor cmtTbl + printExceptionDef ~state extensionConstructor cmtTbl in collectRows ((loc, letExceptionDoc) :: acc) expr2 | Pexp_open (overrideFlag, longidentLoc, expr2) -> @@ -5078,7 +4963,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = collectRows ((loc, openDoc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> let exprDoc = - let doc = printExpression ~customLayout expr1 cmtTbl in + let doc = printExpression ~state expr1 cmtTbl in match Parens.expr expr1 with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr1 braces @@ -5105,9 +4990,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = - printValueBindings ~customLayout ~recFlag valueBindings cmtTbl - in + let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in (* let () = { * let () = foo() * () @@ -5120,7 +5003,7 @@ and printExpressionBlock ~customLayout ~braces expr cmtTbl = | _ -> collectRows ((loc, letDoc) :: acc) expr2) | _ -> let exprDoc = - let doc = printExpression ~customLayout expr cmtTbl in + let doc = printExpression ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -5197,7 +5080,7 @@ and printDirectionFlag flag = | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = +and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group @@ -5207,7 +5090,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = (* print punned field *) Doc.concat [ - printAttributes ~customLayout expr.pexp_attributes cmtTbl; + printAttributes ~state expr.pexp_attributes cmtTbl; printOptionalLabel expr.pexp_attributes; printLidentPath lbl cmtTbl; ] @@ -5217,7 +5100,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = printLidentPath lbl cmtTbl; Doc.text ": "; printOptionalLabel expr.pexp_attributes; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.exprRecordRowRhs expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -5226,7 +5109,7 @@ and printExpressionRecordRow ~customLayout (lbl, expr) cmtTbl punningAllowed = in printComments doc cmtTbl cmtLoc -and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = +and printBsObjectRow ~state (lbl, expr) cmtTbl = let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let lblDoc = let doc = @@ -5239,7 +5122,7 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = [ lblDoc; Doc.text ": "; - (let doc = printExpressionWithComments ~customLayout expr cmtTbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with | Parens.Parenthesized -> addParens doc | Braced braces -> printBraces doc expr braces @@ -5254,8 +5137,8 @@ and printBsObjectRow ~customLayout (lbl, expr) cmtTbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and printAttributes ?loc ?(inline = false) ~customLayout - (attrs : Parsetree.attributes) cmtTbl = +and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmtTbl = match ParsetreeViewer.filterParsingAttrs attrs with | [] -> Doc.nil | attrs -> @@ -5273,17 +5156,15 @@ and printAttributes ?loc ?(inline = false) ~customLayout [ Doc.group (Doc.joinWithSep - (List.map - (fun attr -> printAttribute ~customLayout attr cmtTbl) - attrs)); + (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); (if inline then Doc.space else lineBreak); ] -and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = +and printPayload ~state (payload : Parsetree.payload) cmtTbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments ~customLayout expr cmtTbl in + let exprDoc = printExpressionWithComments ~state expr cmtTbl in let needsParens = match attrs with | [] -> false @@ -5294,7 +5175,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.concat [ Doc.lparen; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); Doc.rparen; ] @@ -5306,22 +5187,21 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = (Doc.concat [ Doc.softLine; - printAttributes ~customLayout attrs cmtTbl; + printAttributes ~state attrs cmtTbl; (if needsParens then addParens exprDoc else exprDoc); ]); Doc.softLine; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - addParens (printStructureItem ~customLayout si cmtTbl) - | PStr structure -> addParens (printStructure ~customLayout structure cmtTbl) + addParens (printStructureItem ~state si cmtTbl) + | PStr structure -> addParens (printStructure ~state structure cmtTbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent - (Doc.concat [Doc.line; printTypExpr ~customLayout typ cmtTbl]); + Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); Doc.softLine; Doc.rparen; ] @@ -5333,7 +5213,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~customLayout expr cmtTbl; + printExpressionWithComments ~state expr cmtTbl; ] | None -> Doc.nil in @@ -5345,7 +5225,7 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = [ Doc.softLine; Doc.text "? "; - printPattern ~customLayout pat cmtTbl; + printPattern ~state pat cmtTbl; whenDoc; ]); Doc.softLine; @@ -5357,12 +5237,12 @@ and printPayload ~customLayout (payload : Parsetree.payload) cmtTbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; printSignature ~customLayout signature cmtTbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.softLine; Doc.rparen; ] -and printAttribute ?(standalone = false) ~customLayout +and printAttribute ?(standalone = false) ~state ((id, payload) : Parsetree.attribute) cmtTbl = match (id, payload) with | ( {txt = "ns.doc"}, @@ -5386,11 +5266,11 @@ and printAttribute ?(standalone = false) ~customLayout [ Doc.text (if standalone then "@@" else "@"); Doc.text (convertBsExternalAttribute id.txt); - printPayload ~customLayout payload cmtTbl; + printPayload ~state payload cmtTbl; ]), Doc.line ) -and printModExpr ~customLayout modExpr cmtTbl = +and printModExpr ~state modExpr cmtTbl = let doc = match modExpr.pmod_desc with | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl @@ -5408,7 +5288,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.lbrace; Doc.indent (Doc.concat - [Doc.softLine; printStructure ~customLayout structure cmtTbl]); + [Doc.softLine; printStructure ~state structure cmtTbl]); Doc.softLine; Doc.rbrace; ]) @@ -5428,7 +5308,7 @@ and printModExpr ~customLayout modExpr cmtTbl = (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> let packageDoc = let doc = - printPackageType ~customLayout ~printModuleKeywordAndParens:false + printPackageType ~state ~printModuleKeywordAndParens:false packageType cmtTbl in printComments doc cmtTbl ptyp_loc @@ -5444,10 +5324,7 @@ and printModExpr ~customLayout modExpr cmtTbl = let unpackDoc = Doc.group (Doc.concat - [ - printExpressionWithComments ~customLayout expr cmtTbl; - moduleConstraint; - ]) + [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) in Doc.group (Doc.concat @@ -5463,7 +5340,7 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.rparen; ]) | Pmod_extension extension -> - printExtension ~customLayout ~atModuleLvl:false extension cmtTbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmod_apply _ -> let args, callExpr = ParsetreeViewer.modExprApply modExpr in let isUnitSugar = @@ -5479,17 +5356,15 @@ and printModExpr ~customLayout modExpr cmtTbl = Doc.group (Doc.concat [ - printModExpr ~customLayout callExpr cmtTbl; + printModExpr ~state callExpr cmtTbl; (if isUnitSugar then - printModApplyArg ~customLayout - (List.hd args [@doesNotRaise]) - cmtTbl + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else Doc.concat [ Doc.lparen; (if shouldHug then - printModApplyArg ~customLayout + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else @@ -5501,7 +5376,7 @@ and printModExpr ~customLayout modExpr cmtTbl = ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun modArg -> - printModApplyArg ~customLayout modArg cmtTbl) + printModApplyArg ~state modArg cmtTbl) args); ])); (if not shouldHug then @@ -5513,15 +5388,15 @@ and printModExpr ~customLayout modExpr cmtTbl = | Pmod_constraint (modExpr, modType) -> Doc.concat [ - printModExpr ~customLayout modExpr cmtTbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - printModType ~customLayout modType cmtTbl; + printModType ~state modType cmtTbl; ] - | Pmod_functor _ -> printModFunctor ~customLayout modExpr cmtTbl + | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl in printComments doc cmtTbl modExpr.pmod_loc -and printModFunctor ~customLayout modExpr cmtTbl = +and printModFunctor ~state modExpr cmtTbl = let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) @@ -5532,18 +5407,18 @@ and printModFunctor ~customLayout modExpr cmtTbl = match returnModExpr.pmod_desc with | Pmod_constraint (modExpr, modType) -> let constraintDoc = - let doc = printModType ~customLayout modType cmtTbl in + let doc = printModType ~state modType cmtTbl in if Parens.modExprFunctorConstraint modType then addParens doc else doc in let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in - (modConstraint, printModExpr ~customLayout modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr ~customLayout returnModExpr cmtTbl) + (modConstraint, printModExpr ~state modExpr cmtTbl) + | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) in let parametersDoc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [printAttributes ~customLayout attrs cmtTbl; Doc.text "()"]) + (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -5557,8 +5432,7 @@ and printModFunctor ~customLayout modExpr cmtTbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> - printModFunctorParam ~customLayout param cmtTbl) + (fun param -> printModFunctorParam ~state param cmtTbl) parameters); ]); Doc.trailingComma; @@ -5570,14 +5444,14 @@ and printModFunctor ~customLayout modExpr cmtTbl = (Doc.concat [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) -and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = +and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = let cmtLoc = match optModType with | None -> lbl.Asttypes.loc | Some modType -> {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~customLayout attrs cmtTbl in + let attrs = printAttributes ~state attrs cmtTbl in let lblDoc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in printComments doc cmtTbl lbl.loc @@ -5591,19 +5465,17 @@ and printModFunctorParam ~customLayout (attrs, lbl, optModType) cmtTbl = (match optModType with | None -> Doc.nil | Some modType -> - Doc.concat - [Doc.text ": "; printModType ~customLayout modType cmtTbl]); + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); ]) in printComments doc cmtTbl cmtLoc -and printModApplyArg ~customLayout modExpr cmtTbl = +and printModApplyArg ~state modExpr cmtTbl = match modExpr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr ~customLayout modExpr cmtTbl + | _ -> printModExpr ~state modExpr cmtTbl -and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) - cmtTbl = +and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = let kind = match constr.pext_kind with | Pext_rebind longident -> @@ -5614,15 +5486,11 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc @@ -5631,7 +5499,7 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) Doc.group (Doc.concat [ - printAttributes ~customLayout constr.pext_attributes cmtTbl; + printAttributes ~state constr.pext_attributes cmtTbl; Doc.text "exception "; name; kind; @@ -5639,9 +5507,9 @@ and printExceptionDef ~customLayout (constr : Parsetree.extension_constructor) in printComments doc cmtTbl constr.pext_loc -and printExtensionConstructor ~customLayout - (constr : Parsetree.extension_constructor) cmtTbl i = - let attrs = printAttributes ~customLayout constr.pext_attributes cmtTbl in +and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) + cmtTbl i = + let attrs = printAttributes ~state constr.pext_attributes cmtTbl in let bar = if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil in @@ -5655,37 +5523,33 @@ and printExtensionConstructor ~customLayout | Pext_decl (args, gadt) -> let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; printTypExpr ~customLayout typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - printConstructorArguments ~customLayout ~indent:false args cmtTbl; - gadtDoc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -let printTypeParams = printTypeParams ~customLayout:0 -let printTypExpr = printTypExpr ~customLayout:0 -let printExpression = printExpression ~customLayout:0 -let printPattern = printPattern ~customLayout:0 +let printTypeParams = printTypeParams ~state:State.init +let printTypExpr = printTypExpr ~state:State.init +let printExpression = printExpression ~state:State.init +let printPattern = printPattern ~state:State.init let printImplementation ~width (s : Parsetree.structure) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkStructure s cmtTbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure ~customLayout:0 s cmtTbl in + let doc = printStructure ~state:State.init s cmtTbl in (* Doc.debug doc; *) Doc.toString ~width doc ^ "\n" let printInterface ~width (s : Parsetree.signature) ~comments = let cmtTbl = CommentTable.make () in CommentTable.walkSignature s cmtTbl comments; - Doc.toString ~width (printSignature ~customLayout:0 s cmtTbl) ^ "\n" + Doc.toString ~width (printSignature ~state:State.init s cmtTbl) ^ "\n" -let printStructure = printStructure ~customLayout:0 +let printStructure = printStructure ~state:State.init From 75674ca922a2be62a318155c6312930511a486b7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 07:47:32 +0100 Subject: [PATCH 08/16] Refactor: rename uncurried attribute to dotted attribute --- lib/4.06.1/unstable/js_compiler.ml | 44 +++++++++---------- lib/4.06.1/unstable/js_playground_compiler.ml | 44 +++++++++---------- lib/4.06.1/whole_compiler.ml | 44 +++++++++---------- res_syntax/src/res_parsetree_viewer.ml | 8 ++-- res_syntax/src/res_parsetree_viewer.mli | 3 +- res_syntax/src/res_printer.ml | 33 +++++++------- 6 files changed, 84 insertions(+), 92 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 4c6c2dcb95..708f120e2a 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49396,8 +49396,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processUncurriedAttribute : - Parsetree.attributes -> bool * Parsetree.attributes +val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -49588,12 +49587,12 @@ let functorType modtype = in process [] modtype -let processUncurriedAttribute attrs = - let rec process uncurriedSpotted acc attrs = +let processDottedAttribute attrs = + let rec process dottedSpotted acc attrs = match attrs with - | [] -> (uncurriedSpotted, List.rev acc) + | [] -> (dottedSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process uncurriedSpotted (attr :: acc) rest + | attr :: rest -> process dottedSpotted (attr :: acc) rest in process false [] attrs @@ -53640,9 +53639,9 @@ let printOptionalLabel attrs = module State = struct let customLayoutThreshold = 2 - type t = {customLayout: int; uncurried: bool} + type t = {customLayout: int; mutable uncurried_by_default: bool} - let init = {customLayout = 0; uncurried = false} + let init = {customLayout = 0; uncurried_by_default = false} let nextCustomLayout t = {t with customLayout = t.customLayout + 1} @@ -54617,10 +54616,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = - ParsetreeViewer.processUncurriedAttribute attrsBefore - in - (uncurried || isUncurried, attrs) + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in + (uncurried || dotted, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54968,10 +54965,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -57001,8 +56996,8 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let uncurried, attrs = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + let dotted, attrs = + ParsetreeViewer.processDottedAttribute expr.pexp_attributes in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -57013,12 +57008,14 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args + cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args + cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57045,7 +57042,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried args cmtTbl in + let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -57890,9 +57887,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) @@ -58326,6 +58323,7 @@ and printAttribute ?(standalone = false) ~state ], Doc.hardLine ) | _ -> + if id.txt = "uncurried" then state.uncurried_by_default <- true; ( Doc.group (Doc.concat [ diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 904e0dd4b2..013c0ee13b 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49396,8 +49396,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processUncurriedAttribute : - Parsetree.attributes -> bool * Parsetree.attributes +val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -49588,12 +49587,12 @@ let functorType modtype = in process [] modtype -let processUncurriedAttribute attrs = - let rec process uncurriedSpotted acc attrs = +let processDottedAttribute attrs = + let rec process dottedSpotted acc attrs = match attrs with - | [] -> (uncurriedSpotted, List.rev acc) + | [] -> (dottedSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process uncurriedSpotted (attr :: acc) rest + | attr :: rest -> process dottedSpotted (attr :: acc) rest in process false [] attrs @@ -53640,9 +53639,9 @@ let printOptionalLabel attrs = module State = struct let customLayoutThreshold = 2 - type t = {customLayout: int; uncurried: bool} + type t = {customLayout: int; mutable uncurried_by_default: bool} - let init = {customLayout = 0; uncurried = false} + let init = {customLayout = 0; uncurried_by_default = false} let nextCustomLayout t = {t with customLayout = t.customLayout + 1} @@ -54617,10 +54616,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = - ParsetreeViewer.processUncurriedAttribute attrsBefore - in - (uncurried || isUncurried, attrs) + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in + (uncurried || dotted, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54968,10 +54965,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -57001,8 +56996,8 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let uncurried, attrs = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + let dotted, attrs = + ParsetreeViewer.processDottedAttribute expr.pexp_attributes in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -57013,12 +57008,14 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args + cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args + cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57045,7 +57042,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried args cmtTbl in + let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -57890,9 +57887,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) @@ -58326,6 +58323,7 @@ and printAttribute ?(standalone = false) ~state ], Doc.hardLine ) | _ -> + if id.txt = "uncurried" then state.uncurried_by_default <- true; ( Doc.group (Doc.concat [ diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 67414430a4..9ffed63ca8 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104391,8 +104391,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processUncurriedAttribute : - Parsetree.attributes -> bool * Parsetree.attributes +val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -104583,12 +104582,12 @@ let functorType modtype = in process [] modtype -let processUncurriedAttribute attrs = - let rec process uncurriedSpotted acc attrs = +let processDottedAttribute attrs = + let rec process dottedSpotted acc attrs = match attrs with - | [] -> (uncurriedSpotted, List.rev acc) + | [] -> (dottedSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process uncurriedSpotted (attr :: acc) rest + | attr :: rest -> process dottedSpotted (attr :: acc) rest in process false [] attrs @@ -108635,9 +108634,9 @@ let printOptionalLabel attrs = module State = struct let customLayoutThreshold = 2 - type t = {customLayout: int; uncurried: bool} + type t = {customLayout: int; mutable uncurried_by_default: bool} - let init = {customLayout = 0; uncurried = false} + let init = {customLayout = 0; uncurried_by_default = false} let nextCustomLayout t = {t with customLayout = t.customLayout + 1} @@ -109612,10 +109611,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = - ParsetreeViewer.processUncurriedAttribute attrsBefore - in - (uncurried || isUncurried, attrs) + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in + (uncurried || dotted, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -109963,10 +109960,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -111996,8 +111991,8 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let uncurried, attrs = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + let dotted, attrs = + ParsetreeViewer.processDottedAttribute expr.pexp_attributes in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -112008,12 +112003,14 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args + cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args + cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -112040,7 +112037,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried args cmtTbl in + let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -112885,9 +112882,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) @@ -113321,6 +113318,7 @@ and printAttribute ?(standalone = false) ~state ], Doc.hardLine ) | _ -> + if id.txt = "uncurried" then state.uncurried_by_default <- true; ( Doc.group (Doc.concat [ diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index 374ec7b2cd..f3be13c819 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -47,12 +47,12 @@ let functorType modtype = in process [] modtype -let processUncurriedAttribute attrs = - let rec process uncurriedSpotted acc attrs = +let processDottedAttribute attrs = + let rec process dottedSpotted acc attrs = match attrs with - | [] -> (uncurriedSpotted, List.rev acc) + | [] -> (dottedSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process uncurriedSpotted (attr :: acc) rest + | attr :: rest -> process dottedSpotted (attr :: acc) rest in process false [] attrs diff --git a/res_syntax/src/res_parsetree_viewer.mli b/res_syntax/src/res_parsetree_viewer.mli index abed6a3105..b1957abd0f 100644 --- a/res_syntax/src/res_parsetree_viewer.mli +++ b/res_syntax/src/res_parsetree_viewer.mli @@ -14,8 +14,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processUncurriedAttribute : - Parsetree.attributes -> bool * Parsetree.attributes +val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index aa3afb2004..1b43f2a219 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -575,9 +575,9 @@ let printOptionalLabel attrs = module State = struct let customLayoutThreshold = 2 - type t = {customLayout: int; uncurried: bool} + type t = {customLayout: int; mutable uncurried_by_default: bool} - let init = {customLayout = 0; uncurried = false} + let init = {customLayout = 0; uncurried_by_default = false} let nextCustomLayout t = {t with customLayout = t.customLayout + 1} @@ -1552,10 +1552,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = - ParsetreeViewer.processUncurriedAttribute attrsBefore - in - (uncurried || isUncurried, attrs) + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in + (uncurried || dotted, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -1903,10 +1901,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -3936,8 +3932,8 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let uncurried, attrs = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + let dotted, attrs = + ParsetreeViewer.processDottedAttribute expr.pexp_attributes in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -3948,12 +3944,14 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl + printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args + cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args + cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -3980,7 +3978,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried args cmtTbl in + let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -4825,9 +4823,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let isUncurried, attrs = ParsetreeViewer.processUncurriedAttribute attrs in + let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in let uncurried = - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) @@ -5261,6 +5259,7 @@ and printAttribute ?(standalone = false) ~state ], Doc.hardLine ) | _ -> + if id.txt = "uncurried" then state.uncurried_by_default <- true; ( Doc.group (Doc.concat [ From f931af426d0216eae5be4a9a4d57054e5e284a70 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 08:00:34 +0100 Subject: [PATCH 09/16] Printer: add support for uncurried mode in application --- lib/4.06.1/unstable/js_compiler.ml | 61 ++++++++++--------- lib/4.06.1/unstable/js_playground_compiler.ml | 61 ++++++++++--------- lib/4.06.1/whole_compiler.ml | 61 ++++++++++--------- res_syntax/src/res_parsetree_viewer.ml | 8 +-- res_syntax/src/res_parsetree_viewer.mli | 2 +- res_syntax/src/res_printer.ml | 51 ++++++++-------- .../tests/printer/expr/UncurriedByDefault.res | 27 ++++++++ .../expr/expected/UncurriedByDefault.res.txt | 27 ++++++++ 8 files changed, 178 insertions(+), 120 deletions(-) create mode 100644 res_syntax/tests/printer/expr/UncurriedByDefault.res create mode 100644 res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 708f120e2a..53929ef4a8 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49396,7 +49396,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -49587,12 +49587,12 @@ let functorType modtype = in process [] modtype -let processDottedAttribute attrs = - let rec process dottedSpotted acc attrs = +let processBsAttribute attrs = + let rec process bsSpotted acc attrs = match attrs with - | [] -> (dottedSpotted, List.rev acc) + | [] -> (bsSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process dottedSpotted (attr :: acc) rest + | attr :: rest -> process bsSpotted (attr :: acc) rest in process false [] attrs @@ -54616,8 +54616,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in - (uncurried || dotted, attrs) + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in + (uncurried || hasBs, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54965,8 +54965,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in - let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -56996,8 +56996,11 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let dotted, attrs = - ParsetreeViewer.processDottedAttribute expr.pexp_attributes + let hasBs, attrs = + ParsetreeViewer.processBsAttribute expr.pexp_attributes + in + let dotted = + if state.State.uncurried_by_default then not hasBs else hasBs in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -57008,14 +57011,12 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57042,7 +57043,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in + let argsDoc = printArguments ~state ~dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -57364,7 +57365,7 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -57405,7 +57406,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(. " else Doc.lparen); + (if dotted then Doc.text "(. " else Doc.lparen); Lazy.force callback; Doc.comma; Doc.line; @@ -57421,7 +57422,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = * arg3, * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57442,7 +57443,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -57492,7 +57493,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Lazy.force callback; Doc.rparen; @@ -57507,7 +57508,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); Doc.rparen; @@ -57521,7 +57522,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57548,7 +57549,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = Lazy.force breakAllArgs; ] -and printArguments ~state ~uncurried +and printArguments ~state ~dotted (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -57561,7 +57562,7 @@ and printArguments ~state ~uncurried (* See "parseCallExpr", ghost unit expression is used the implement * arity zero vs arity one syntax. * Related: https://github.com/rescript-lang/syntax/issues/138 *) - match (uncurried, loc.loc_ghost) with + match (dotted, loc.loc_ghost) with | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") @@ -57574,16 +57575,16 @@ and printArguments ~state ~uncurried | Nothing -> doc in Doc.concat - [(if uncurried then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] | args -> Doc.group (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Doc.indent (Doc.concat [ - (if uncurried then Doc.line else Doc.softLine); + (if dotted then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun arg -> printArgument ~state arg cmtTbl) args); @@ -57887,9 +57888,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in let uncurried = - if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 013c0ee13b..ca52ed96b3 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49396,7 +49396,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -49587,12 +49587,12 @@ let functorType modtype = in process [] modtype -let processDottedAttribute attrs = - let rec process dottedSpotted acc attrs = +let processBsAttribute attrs = + let rec process bsSpotted acc attrs = match attrs with - | [] -> (dottedSpotted, List.rev acc) + | [] -> (bsSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process dottedSpotted (attr :: acc) rest + | attr :: rest -> process bsSpotted (attr :: acc) rest in process false [] attrs @@ -54616,8 +54616,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in - (uncurried || dotted, attrs) + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in + (uncurried || hasBs, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54965,8 +54965,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in - let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -56996,8 +56996,11 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let dotted, attrs = - ParsetreeViewer.processDottedAttribute expr.pexp_attributes + let hasBs, attrs = + ParsetreeViewer.processBsAttribute expr.pexp_attributes + in + let dotted = + if state.State.uncurried_by_default then not hasBs else hasBs in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -57008,14 +57011,12 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -57042,7 +57043,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in + let argsDoc = printArguments ~state ~dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -57364,7 +57365,7 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -57405,7 +57406,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(. " else Doc.lparen); + (if dotted then Doc.text "(. " else Doc.lparen); Lazy.force callback; Doc.comma; Doc.line; @@ -57421,7 +57422,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = * arg3, * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57442,7 +57443,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -57492,7 +57493,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Lazy.force callback; Doc.rparen; @@ -57507,7 +57508,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); Doc.rparen; @@ -57521,7 +57522,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -57548,7 +57549,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = Lazy.force breakAllArgs; ] -and printArguments ~state ~uncurried +and printArguments ~state ~dotted (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -57561,7 +57562,7 @@ and printArguments ~state ~uncurried (* See "parseCallExpr", ghost unit expression is used the implement * arity zero vs arity one syntax. * Related: https://github.com/rescript-lang/syntax/issues/138 *) - match (uncurried, loc.loc_ghost) with + match (dotted, loc.loc_ghost) with | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") @@ -57574,16 +57575,16 @@ and printArguments ~state ~uncurried | Nothing -> doc in Doc.concat - [(if uncurried then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] | args -> Doc.group (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Doc.indent (Doc.concat [ - (if uncurried then Doc.line else Doc.softLine); + (if dotted then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun arg -> printArgument ~state arg cmtTbl) args); @@ -57887,9 +57888,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in let uncurried = - if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 9ffed63ca8..ded05f30df 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104391,7 +104391,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; @@ -104582,12 +104582,12 @@ let functorType modtype = in process [] modtype -let processDottedAttribute attrs = - let rec process dottedSpotted acc attrs = +let processBsAttribute attrs = + let rec process bsSpotted acc attrs = match attrs with - | [] -> (dottedSpotted, List.rev acc) + | [] -> (bsSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process dottedSpotted (attr :: acc) rest + | attr :: rest -> process bsSpotted (attr :: acc) rest in process false [] attrs @@ -109611,8 +109611,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in - (uncurried || dotted, attrs) + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in + (uncurried || hasBs, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -109960,8 +109960,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in - let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -111991,8 +111991,11 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let dotted, attrs = - ParsetreeViewer.processDottedAttribute expr.pexp_attributes + let hasBs, attrs = + ParsetreeViewer.processBsAttribute expr.pexp_attributes + in + let dotted = + if state.State.uncurried_by_default then not hasBs else hasBs in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -112003,14 +112006,12 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -112037,7 +112038,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in + let argsDoc = printArguments ~state ~dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -112359,7 +112360,7 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -112400,7 +112401,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(. " else Doc.lparen); + (if dotted then Doc.text "(. " else Doc.lparen); Lazy.force callback; Doc.comma; Doc.line; @@ -112416,7 +112417,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = * arg3, * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -112437,7 +112438,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -112487,7 +112488,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Lazy.force callback; Doc.rparen; @@ -112502,7 +112503,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); Doc.rparen; @@ -112516,7 +112517,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -112543,7 +112544,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = Lazy.force breakAllArgs; ] -and printArguments ~state ~uncurried +and printArguments ~state ~dotted (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -112556,7 +112557,7 @@ and printArguments ~state ~uncurried (* See "parseCallExpr", ghost unit expression is used the implement * arity zero vs arity one syntax. * Related: https://github.com/rescript-lang/syntax/issues/138 *) - match (uncurried, loc.loc_ghost) with + match (dotted, loc.loc_ghost) with | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") @@ -112569,16 +112570,16 @@ and printArguments ~state ~uncurried | Nothing -> doc in Doc.concat - [(if uncurried then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] | args -> Doc.group (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Doc.indent (Doc.concat [ - (if uncurried then Doc.line else Doc.softLine); + (if dotted then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun arg -> printArgument ~state arg cmtTbl) args); @@ -112882,9 +112883,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in let uncurried = - if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index f3be13c819..afa73cb68f 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -47,12 +47,12 @@ let functorType modtype = in process [] modtype -let processDottedAttribute attrs = - let rec process dottedSpotted acc attrs = +let processBsAttribute attrs = + let rec process bsSpotted acc attrs = match attrs with - | [] -> (dottedSpotted, List.rev acc) + | [] -> (bsSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process dottedSpotted (attr :: acc) rest + | attr :: rest -> process bsSpotted (attr :: acc) rest in process false [] attrs diff --git a/res_syntax/src/res_parsetree_viewer.mli b/res_syntax/src/res_parsetree_viewer.mli index b1957abd0f..9837a71850 100644 --- a/res_syntax/src/res_parsetree_viewer.mli +++ b/res_syntax/src/res_parsetree_viewer.mli @@ -14,7 +14,7 @@ val functorType : * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processDottedAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes type functionAttributesInfo = { async: bool; diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index 1b43f2a219..c3dc358e94 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -1552,8 +1552,8 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in let uncurried, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrsBefore in - (uncurried || dotted, attrs) + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in + (uncurried || hasBs, attrs) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -1901,8 +1901,8 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = * i.e. ~foo: string, ~bar: float *) and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in - let uncurried = if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -3932,8 +3932,11 @@ and printPexpApply ~state expr cmtTbl = (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in - let dotted, attrs = - ParsetreeViewer.processDottedAttribute expr.pexp_attributes + let hasBs, attrs = + ParsetreeViewer.processBsAttribute expr.pexp_attributes + in + let dotted = + if state.State.uncurried_by_default then not hasBs else hasBs in let callExprDoc = let doc = printExpressionWithComments ~state callExpr cmtTbl in @@ -3944,14 +3947,12 @@ and printPexpApply ~state expr cmtTbl = in if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried:dotted ~state args - cmtTbl + printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~uncurried:dotted args - cmtTbl + printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -3978,7 +3979,7 @@ and printPexpApply ~state expr cmtTbl = argsDoc; ] else - let argsDoc = printArguments ~state ~uncurried:dotted args cmtTbl in + let argsDoc = printArguments ~state ~dotted args cmtTbl in Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false @@ -4300,7 +4301,7 @@ and printJsxName {txt = lident} = let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) -and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = +and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -4341,7 +4342,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(. " else Doc.lparen); + (if dotted then Doc.text "(. " else Doc.lparen); Lazy.force callback; Doc.comma; Doc.line; @@ -4357,7 +4358,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = * arg3, * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4378,7 +4379,7 @@ and printArgumentsWithCallbackInFirstPosition ~uncurried ~state args cmtTbl = else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = +and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) @@ -4428,7 +4429,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Lazy.force callback; Doc.rparen; @@ -4443,7 +4444,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = lazy (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Lazy.force printedArgs; Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); Doc.rparen; @@ -4457,7 +4458,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = lazy (printArguments ~state ~uncurried args cmtTblCopy2) in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4484,7 +4485,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~uncurried args cmtTbl = Lazy.force breakAllArgs; ] -and printArguments ~state ~uncurried +and printArguments ~state ~dotted (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ @@ -4497,7 +4498,7 @@ and printArguments ~state ~uncurried (* See "parseCallExpr", ghost unit expression is used the implement * arity zero vs arity one syntax. * Related: https://github.com/rescript-lang/syntax/issues/138 *) - match (uncurried, loc.loc_ghost) with + match (dotted, loc.loc_ghost) with | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") @@ -4510,16 +4511,16 @@ and printArguments ~state ~uncurried | Nothing -> doc in Doc.concat - [(if uncurried then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] | args -> Doc.group (Doc.concat [ - (if uncurried then Doc.text "(." else Doc.lparen); + (if dotted then Doc.text "(." else Doc.lparen); Doc.indent (Doc.concat [ - (if uncurried then Doc.line else Doc.softLine); + (if dotted then Doc.line else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun arg -> printArgument ~state arg cmtTbl) args); @@ -4823,9 +4824,9 @@ and printExpFunParameter ~state parameter cmtTbl = lbls); ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let dotted, attrs = ParsetreeViewer.processDottedAttribute attrs in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in let uncurried = - if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil + if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res new file mode 100644 index 0000000000..bb2152af70 --- /dev/null +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -0,0 +1,27 @@ +let cApp = foo(3) +let uApp = foo(. 3) + +// let cFun = x => 3 +// let uFun = (.x) => 3 +// let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +// let bracesFun = (. x) => y => x+y + +// type cTyp = string => int +// type uTyp = (. string) => int +// type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int +// type bTyp = (. string) => string => int + +@@uncurried + +let cApp = foo(. 3) +let uApp = foo(3) + +// let cFun = (. x) => 3 +// let uFun = x => 3 +// let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +// let bracesFun = x => (. y) => x+y + +// type cTyp = (. string) => int +// type uTyp = string => int +// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +// type bTyp = string => (. string) => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt new file mode 100644 index 0000000000..bb2152af70 --- /dev/null +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -0,0 +1,27 @@ +let cApp = foo(3) +let uApp = foo(. 3) + +// let cFun = x => 3 +// let uFun = (.x) => 3 +// let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +// let bracesFun = (. x) => y => x+y + +// type cTyp = string => int +// type uTyp = (. string) => int +// type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int +// type bTyp = (. string) => string => int + +@@uncurried + +let cApp = foo(. 3) +let uApp = foo(3) + +// let cFun = (. x) => 3 +// let uFun = x => 3 +// let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +// let bracesFun = x => (. y) => x+y + +// type cTyp = (. string) => int +// type uTyp = string => int +// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +// type bTyp = string => (. string) => int From d598ad66266efce8e88a65c465cb8a184f9a587c Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 08:32:17 +0100 Subject: [PATCH 10/16] Printer: uncurried mode support for function declarations --- lib/4.06.1/unstable/js_compiler.ml | 21 ++++++++----------- lib/4.06.1/unstable/js_playground_compiler.ml | 21 ++++++++----------- lib/4.06.1/whole_compiler.ml | 21 ++++++++----------- res_syntax/src/res_printer.ml | 21 ++++++++----------- .../expressions/UncurriedByDefault.res | 4 ++++ .../tests/printer/expr/UncurriedByDefault.res | 18 +++++++++------- .../expr/expected/UncurriedByDefault.res.txt | 18 +++++++++------- 7 files changed, 62 insertions(+), 62 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 53929ef4a8..6796295320 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -57776,6 +57776,9 @@ and printCase ~state (case : Parsetree.case) cmtTbl = and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint parameters cmtTbl = + let dotted = + if state.State.uncurried_by_default then not uncurried else uncurried + in match parameters with (* let f = _ => () *) | [ @@ -57787,7 +57790,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] - when not uncurried -> + when not dotted -> let any = let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in printComments doc cmtTbl ppat_loc @@ -57807,7 +57810,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint }; }; ] - when not uncurried -> + when not dotted -> let txtDoc = let var = printIdentLike stringLoc.txt in let var = @@ -57831,7 +57834,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] - when not uncurried -> + when not dotted -> let doc = let lparenRparen = Doc.text "()" in if async then addAsync lparenRparen else lparenRparen @@ -57845,7 +57848,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint | _ -> false in let maybeAsyncLparen = - let lparen = if uncurried then Doc.text "(. " else Doc.lparen in + let lparen = if dotted then Doc.text "(. " else Doc.lparen in if async then addAsync lparen else lparen in let shouldHug = ParsetreeViewer.parametersShouldHug parameters in @@ -57889,9 +57892,7 @@ and printExpFunParameter ~state parameter cmtTbl = ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = - if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = @@ -57950,11 +57951,7 @@ and printExpFunParameter ~state parameter cmtTbl = Doc.group (Doc.concat [ - uncurried; - attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; ]) in let cmtLoc = diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index ca52ed96b3..53d7bec26e 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -57776,6 +57776,9 @@ and printCase ~state (case : Parsetree.case) cmtTbl = and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint parameters cmtTbl = + let dotted = + if state.State.uncurried_by_default then not uncurried else uncurried + in match parameters with (* let f = _ => () *) | [ @@ -57787,7 +57790,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] - when not uncurried -> + when not dotted -> let any = let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in printComments doc cmtTbl ppat_loc @@ -57807,7 +57810,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint }; }; ] - when not uncurried -> + when not dotted -> let txtDoc = let var = printIdentLike stringLoc.txt in let var = @@ -57831,7 +57834,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] - when not uncurried -> + when not dotted -> let doc = let lparenRparen = Doc.text "()" in if async then addAsync lparenRparen else lparenRparen @@ -57845,7 +57848,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint | _ -> false in let maybeAsyncLparen = - let lparen = if uncurried then Doc.text "(. " else Doc.lparen in + let lparen = if dotted then Doc.text "(. " else Doc.lparen in if async then addAsync lparen else lparen in let shouldHug = ParsetreeViewer.parametersShouldHug parameters in @@ -57889,9 +57892,7 @@ and printExpFunParameter ~state parameter cmtTbl = ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = - if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = @@ -57950,11 +57951,7 @@ and printExpFunParameter ~state parameter cmtTbl = Doc.group (Doc.concat [ - uncurried; - attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; ]) in let cmtLoc = diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index ded05f30df..1e6735fc5f 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -112771,6 +112771,9 @@ and printCase ~state (case : Parsetree.case) cmtTbl = and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint parameters cmtTbl = + let dotted = + if state.State.uncurried_by_default then not uncurried else uncurried + in match parameters with (* let f = _ => () *) | [ @@ -112782,7 +112785,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] - when not uncurried -> + when not dotted -> let any = let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in printComments doc cmtTbl ppat_loc @@ -112802,7 +112805,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint }; }; ] - when not uncurried -> + when not dotted -> let txtDoc = let var = printIdentLike stringLoc.txt in let var = @@ -112826,7 +112829,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] - when not uncurried -> + when not dotted -> let doc = let lparenRparen = Doc.text "()" in if async then addAsync lparenRparen else lparenRparen @@ -112840,7 +112843,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint | _ -> false in let maybeAsyncLparen = - let lparen = if uncurried then Doc.text "(. " else Doc.lparen in + let lparen = if dotted then Doc.text "(. " else Doc.lparen in if async then addAsync lparen else lparen in let shouldHug = ParsetreeViewer.parametersShouldHug parameters in @@ -112884,9 +112887,7 @@ and printExpFunParameter ~state parameter cmtTbl = ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = - if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = @@ -112945,11 +112946,7 @@ and printExpFunParameter ~state parameter cmtTbl = Doc.group (Doc.concat [ - uncurried; - attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; ]) in let cmtLoc = diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index c3dc358e94..f03f09952a 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -4712,6 +4712,9 @@ and printCase ~state (case : Parsetree.case) cmtTbl = and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint parameters cmtTbl = + let dotted = + if state.State.uncurried_by_default then not uncurried else uncurried + in match parameters with (* let f = _ => () *) | [ @@ -4723,7 +4726,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] - when not uncurried -> + when not dotted -> let any = let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in printComments doc cmtTbl ppat_loc @@ -4743,7 +4746,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint }; }; ] - when not uncurried -> + when not dotted -> let txtDoc = let var = printIdentLike stringLoc.txt in let var = @@ -4767,7 +4770,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] - when not uncurried -> + when not dotted -> let doc = let lparenRparen = Doc.text "()" in if async then addAsync lparenRparen else lparenRparen @@ -4781,7 +4784,7 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint | _ -> false in let maybeAsyncLparen = - let lparen = if uncurried then Doc.text "(. " else Doc.lparen in + let lparen = if dotted then Doc.text "(. " else Doc.lparen in if async then addAsync lparen else lparen in let shouldHug = ParsetreeViewer.parametersShouldHug parameters in @@ -4825,9 +4828,7 @@ and printExpFunParameter ~state parameter cmtTbl = ]) | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = - if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil - in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) let defaultExprDoc = @@ -4886,11 +4887,7 @@ and printExpFunParameter ~state parameter cmtTbl = Doc.group (Doc.concat [ - uncurried; - attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; ]) in let cmtLoc = diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 2cc753d699..13df0a7f76 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -5,6 +5,8 @@ let cFun = x => 3 let uFun = (.x) => 3 let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 let bracesFun = (. x) => y => x+y +// let cFun2 = (x, y) => 3 +// let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int @@ -20,6 +22,8 @@ let cFun = (. x) => 3 let uFun = x => 3 let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 let bracesFun = x => (. y) => x+y +// let cFun2 = (. x, y) => 3 +// let uFun2 = (x, y) => 3 type cTyp = (. string) => int type uTyp = string => int diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index bb2152af70..8c06192b1f 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -1,10 +1,12 @@ let cApp = foo(3) let uApp = foo(. 3) -// let cFun = x => 3 -// let uFun = (.x) => 3 -// let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 -// let bracesFun = (. x) => y => x+y +let cFun = x => 3 +let uFun = (.x) => 3 +//let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +let bracesFun = (. x) => y => x+y +// let cFun2 = (x, y) => 3 +// let uFun2 = (. x, y) => 3 // type cTyp = string => int // type uTyp = (. string) => int @@ -16,10 +18,12 @@ let uApp = foo(. 3) let cApp = foo(. 3) let uApp = foo(3) -// let cFun = (. x) => 3 -// let uFun = x => 3 +let cFun = (. x) => 3 +let uFun = x => 3 // let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 -// let bracesFun = x => (. y) => x+y +let bracesFun = x => (. y) => x+y +// let cFun2 = (. x, y) => 3 +// let uFun2 = (x, y) => 3 // type cTyp = (. string) => int // type uTyp = string => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index bb2152af70..b8d82ec0a6 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -1,10 +1,12 @@ let cApp = foo(3) let uApp = foo(. 3) -// let cFun = x => 3 -// let uFun = (.x) => 3 -// let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 -// let bracesFun = (. x) => y => x+y +let cFun = x => 3 +let uFun = (. x) => 3 +//let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +let bracesFun = (. x) => {y => x + y} +// let cFun2 = (x, y) => 3 +// let uFun2 = (. x, y) => 3 // type cTyp = string => int // type uTyp = (. string) => int @@ -16,10 +18,12 @@ let uApp = foo(. 3) let cApp = foo(. 3) let uApp = foo(3) -// let cFun = (. x) => 3 -// let uFun = x => 3 +let cFun = (. x) => 3 +let uFun = x => 3 // let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 -// let bracesFun = x => (. y) => x+y +let bracesFun = x => {(. y) => x + y} +// let cFun2 = (. x, y) => 3 +// let uFun2 = (x, y) => 3 // type cTyp = (. string) => int // type uTyp = string => int From bfd522c14629dfade8e9067bdb94dadd6dd6da45 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 08:43:20 +0100 Subject: [PATCH 11/16] Printer: uncurried mode support for types --- lib/4.06.1/unstable/js_compiler.ml | 15 ++++++++------- lib/4.06.1/unstable/js_playground_compiler.ml | 15 ++++++++------- lib/4.06.1/whole_compiler.ml | 15 ++++++++------- res_syntax/src/res_printer.ml | 15 ++++++++------- .../grammar/expressions/UncurriedByDefault.res | 4 ++++ .../tests/printer/expr/UncurriedByDefault.res | 16 ++++++++++------ .../expr/expected/UncurriedByDefault.res.txt | 16 ++++++++++------ 7 files changed, 56 insertions(+), 40 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 6796295320..285770448f 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -54614,10 +54614,12 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in - let uncurried, attrsBefore = + let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in - (uncurried || hasBs, attrs) + ( (if state.State.uncurried_by_default then not uncurried else uncurried) + || hasBs, + attrs ) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54631,7 +54633,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = in match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not uncurried -> + | [([], Nolabel, n)] when not dotted -> let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then @@ -54672,8 +54674,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = (Doc.concat [ Doc.softLine; - (if uncurried then Doc.concat [Doc.dot; Doc.space] - else Doc.nil); + (if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -54966,7 +54967,7 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -54992,7 +54993,7 @@ and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = Doc.group (Doc.concat [ - uncurried; + dotted; attrs; label; printTypExpr ~state typ cmtTbl; diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 53d7bec26e..c470dc2b4a 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -54614,10 +54614,12 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in - let uncurried, attrsBefore = + let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in - (uncurried || hasBs, attrs) + ( (if state.State.uncurried_by_default then not uncurried else uncurried) + || hasBs, + attrs ) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -54631,7 +54633,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = in match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not uncurried -> + | [([], Nolabel, n)] when not dotted -> let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then @@ -54672,8 +54674,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = (Doc.concat [ Doc.softLine; - (if uncurried then Doc.concat [Doc.dot; Doc.space] - else Doc.nil); + (if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -54966,7 +54967,7 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -54992,7 +54993,7 @@ and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = Doc.group (Doc.concat [ - uncurried; + dotted; attrs; label; printTypExpr ~state typ cmtTbl; diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 1e6735fc5f..c8e08eba5e 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -109609,10 +109609,12 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in - let uncurried, attrsBefore = + let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in - (uncurried || hasBs, attrs) + ( (if state.State.uncurried_by_default then not uncurried else uncurried) + || hasBs, + attrs ) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -109626,7 +109628,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = in match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not uncurried -> + | [([], Nolabel, n)] when not dotted -> let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then @@ -109667,8 +109669,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = (Doc.concat [ Doc.softLine; - (if uncurried then Doc.concat [Doc.dot; Doc.space] - else Doc.nil); + (if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -109961,7 +109962,7 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -109987,7 +109988,7 @@ and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = Doc.group (Doc.concat [ - uncurried; + dotted; attrs; label; printTypExpr ~state typ cmtTbl; diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index f03f09952a..e6fa7cdadd 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -1550,10 +1550,12 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = let printArrow ~uncurried typExpr = let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in - let uncurried, attrsBefore = + let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in - (uncurried || hasBs, attrs) + ( (if state.State.uncurried_by_default then not uncurried else uncurried) + || hasBs, + attrs ) in let returnTypeNeedsParens = match returnType.ptyp_desc with @@ -1567,7 +1569,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = in match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not uncurried -> + | [([], Nolabel, n)] when not dotted -> let hasAttrsBefore = not (attrsBefore = []) in let attrs = if hasAttrsBefore then @@ -1608,8 +1610,7 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = (Doc.concat [ Doc.softLine; - (if uncurried then Doc.concat [Doc.dot; Doc.space] - else Doc.nil); + (if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -1902,7 +1903,7 @@ and printObjectField ~state (field : Parsetree.object_field) cmtTbl = and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in - let uncurried = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with @@ -1928,7 +1929,7 @@ and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = Doc.group (Doc.concat [ - uncurried; + dotted; attrs; label; printTypExpr ~state typ cmtTbl; diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 13df0a7f76..c4f4989524 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -12,6 +12,8 @@ type cTyp = string => int type uTyp = (. string) => int type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int type bTyp = (. string) => string => int +// type cTyp2 = (string, string) => int +// type uTyp2 = (.string, string) => int @@uncurried @@ -29,3 +31,5 @@ type cTyp = (. string) => int type uTyp = string => int type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int type bTyp = string => (. string) => int +// type cTyp2 = (.string, string) => int +// type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index 8c06192b1f..3216f31c2c 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -8,10 +8,12 @@ let bracesFun = (. x) => y => x+y // let cFun2 = (x, y) => 3 // let uFun2 = (. x, y) => 3 -// type cTyp = string => int -// type uTyp = (. string) => int -// type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int -// type bTyp = (. string) => string => int +type cTyp = string => int +type uTyp = (. string) => int +type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int +type bTyp = (. string) => string => int +// type cTyp2 = (string, string) => int +// type uTyp2 = (.string, string) => int @@uncurried @@ -25,7 +27,9 @@ let bracesFun = x => (. y) => x+y // let cFun2 = (. x, y) => 3 // let uFun2 = (x, y) => 3 -// type cTyp = (. string) => int -// type uTyp = string => int +type cTyp = (. string) => int +type uTyp = string => int // type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int // type bTyp = string => (. string) => int +// type cTyp2 = (. string, string) => int +// type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index b8d82ec0a6..0e6c8b34ac 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -8,10 +8,12 @@ let bracesFun = (. x) => {y => x + y} // let cFun2 = (x, y) => 3 // let uFun2 = (. x, y) => 3 -// type cTyp = string => int -// type uTyp = (. string) => int -// type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int -// type bTyp = (. string) => string => int +type cTyp = string => int +type uTyp = (. string) => int +type mixTyp = string => (. string, string, string, string, string, string) => (. string) => int +type bTyp = (. string, string) => int +// type cTyp2 = (string, string) => int +// type uTyp2 = (.string, string) => int @@uncurried @@ -25,7 +27,9 @@ let bracesFun = x => {(. y) => x + y} // let cFun2 = (. x, y) => 3 // let uFun2 = (x, y) => 3 -// type cTyp = (. string) => int -// type uTyp = string => int +type cTyp = (. string) => int +type uTyp = string => int // type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int // type bTyp = string => (. string) => int +// type cTyp2 = (. string, string) => int +// type uTyp2 = (string, string) => int From 9805977f22b2f3f3d8e700e777ae7eb368b06c2f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 11:47:42 +0100 Subject: [PATCH 12/16] Fix uncurried case of multiple args, and handle corner case. The corner case has the form: ```res (x, .y) => z => 3 ``` The dot in the middle of a sequence of args does not have a corresponding form in uncurried by default, because non-dots in uncurried by defaults are the normal ways to express the argument after the first. This means there's asymmetry between the two syntaxes. This could be handled by declaring this syntax invalid. Currently we instead parse to the desugaring of the syntax, which in normal mode is: ```res x => (.y) => { z => 3 } ``` And in uncurried mode is expressed as: ```res (.x) => y => { (. z) => 3 } ``` --- lib/4.06.1/unstable/js_playground_compiler.ml | 67 ++++++++++++------- lib/4.06.1/whole_compiler.ml | 67 ++++++++++++------- res_syntax/src/res_core.ml | 67 ++++++++++++------- .../expressions/UncurriedByDefault.res | 11 +-- .../expected/UncurriedByDefault.res.txt | 11 ++- .../tests/printer/expr/UncurriedByDefault.res | 13 ++-- .../expr/expected/UncurriedByDefault.res.txt | 13 ++-- 7 files changed, 155 insertions(+), 94 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index c470dc2b4a..5cf044069e 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -163792,23 +163792,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let body = + let bodyNeedsBraces = + let isFun = + match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false + in match parameters with | TermParameter {dotted} :: _ - when (if p.uncurried_by_default then not dotted else dotted) - && - match body.pexp_desc with - | Pexp_fun _ -> true - | _ -> false -> + when (if p.uncurried_by_default then not dotted else dotted) && isFun -> + true + | TermParameter _ :: rest when (not p.uncurried_by_default) && isFun -> + rest + |> List.exists (function + | TermParameter {dotted} -> dotted + | _ -> false) + | _ -> false + in + let body = + if bodyNeedsBraces then { body with pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; } - | _ -> body + else body in - let arrowExpr, _arity = + let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (expr, arity) -> + (fun parameter (paramNum, expr, arity) -> match parameter with | TermParameter { @@ -163826,33 +163837,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 | _ -> arity in - ( Ast_helper.Exp.record ~loc - [ - ( { - txt = - Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); - loc; - }, - funExpr ); - ] - None, + ( paramNum - 1, + (if true then + Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None + else funExpr), 1 ) - else (funExpr, arity + 1) + else (paramNum - 1, funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> let uncurried = if p.uncurried_by_default then not dotted else dotted in let attrs = if uncurried then uncurryAttr :: attrs else attrs in - (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) - parameters (body, 1) + ( paramNum - 1, + makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, + arity )) + parameters + (List.length parameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index c8e08eba5e..061104e4a8 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -177224,23 +177224,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let body = + let bodyNeedsBraces = + let isFun = + match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false + in match parameters with | TermParameter {dotted} :: _ - when (if p.uncurried_by_default then not dotted else dotted) - && - match body.pexp_desc with - | Pexp_fun _ -> true - | _ -> false -> + when (if p.uncurried_by_default then not dotted else dotted) && isFun -> + true + | TermParameter _ :: rest when (not p.uncurried_by_default) && isFun -> + rest + |> List.exists (function + | TermParameter {dotted} -> dotted + | _ -> false) + | _ -> false + in + let body = + if bodyNeedsBraces then { body with pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; } - | _ -> body + else body in - let arrowExpr, _arity = + let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (expr, arity) -> + (fun parameter (paramNum, expr, arity) -> match parameter with | TermParameter { @@ -177258,33 +177269,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 | _ -> arity in - ( Ast_helper.Exp.record ~loc - [ - ( { - txt = - Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); - loc; - }, - funExpr ); - ] - None, + ( paramNum - 1, + (if true then + Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None + else funExpr), 1 ) - else (funExpr, arity + 1) + else (paramNum - 1, funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> let uncurried = if p.uncurried_by_default then not dotted else dotted in let attrs = if uncurried then uncurryAttr :: attrs else attrs in - (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) - parameters (body, 1) + ( paramNum - 1, + makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, + arity )) + parameters + (List.length parameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 9fc5ff5f97..5c6c1cba39 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -1529,23 +1529,34 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context in Parser.eatBreadcrumb p; let endPos = p.prevEndPos in - let body = + let bodyNeedsBraces = + let isFun = + match body.pexp_desc with + | Pexp_fun _ -> true + | _ -> false + in match parameters with | TermParameter {dotted} :: _ - when (if p.uncurried_by_default then not dotted else dotted) - && - match body.pexp_desc with - | Pexp_fun _ -> true - | _ -> false -> + when (if p.uncurried_by_default then not dotted else dotted) && isFun -> + true + | TermParameter _ :: rest when (not p.uncurried_by_default) && isFun -> + rest + |> List.exists (function + | TermParameter {dotted} -> dotted + | _ -> false) + | _ -> false + in + let body = + if bodyNeedsBraces then { body with pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; } - | _ -> body + else body in - let arrowExpr, _arity = + let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (expr, arity) -> + (fun parameter (paramNum, expr, arity) -> match parameter with | TermParameter { @@ -1563,33 +1574,39 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let arirtForFn = match pat.ppat_desc with | Ppat_construct ({txt = Lident "()"}, _) when arity = 1 -> 0 | _ -> arity in - ( Ast_helper.Exp.record ~loc - [ - ( { - txt = - Ldot - ( Ldot (Lident "Js", "Fn"), - "I" ^ string_of_int arirtForFn ); - loc; - }, - funExpr ); - ] - None, + ( paramNum - 1, + (if true then + Ast_helper.Exp.record ~loc + [ + ( { + txt = + Ldot + ( Ldot (Lident "Js", "Fn"), + "I" ^ string_of_int arirtForFn ); + loc; + }, + funExpr ); + ] + None + else funExpr), 1 ) - else (funExpr, arity + 1) + else (paramNum - 1, funExpr, arity + 1) | TypeParameter {dotted; attrs; locs = newtypes; pos = startPos} -> let uncurried = if p.uncurried_by_default then not dotted else dotted in let attrs = if uncurried then uncurryAttr :: attrs else attrs in - (makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity)) - parameters (body, 1) + ( paramNum - 1, + makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, + arity )) + parameters + (List.length parameters, body, 1) in {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index c4f4989524..8a546b80e7 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -5,8 +5,8 @@ let cFun = x => 3 let uFun = (.x) => 3 let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 let bracesFun = (. x) => y => x+y -// let cFun2 = (x, y) => 3 -// let uFun2 = (. x, y) => 3 +let cFun2 = (x, y) => 3 +let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int @@ -22,10 +22,11 @@ let uApp = foo(3) let cFun = (. x) => 3 let uFun = x => 3 -let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +let mixFun = (.a) => (b, c) => (.d, e, f) => (.g) => h => 4 let bracesFun = x => (. y) => x+y -// let cFun2 = (. x, y) => 3 -// let uFun2 = (x, y) => 3 +let cFun2 = (. x, y) => 3 +let uFun2 = (x, y) => 3 +let cFun2Dots = (.x, .y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 189cdb59f0..544934cd40 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -7,9 +7,12 @@ let mixFun a = Js.Fn.I2 = (fun b -> fun c -> - fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + ((fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + [@ns.braces ])) } let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } +let cFun2 x y = 3 +let uFun2 = { Js.Fn.I2 = (fun x -> fun y -> 3) } type nonrec cTyp = string -> int type nonrec uTyp = (string -> int) Js.Fn.arity1 type nonrec mixTyp = @@ -29,9 +32,13 @@ let mixFun a = Js.Fn.I2 = (fun b -> fun c -> - fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + ((fun d -> fun e -> fun f -> fun g -> { Js.Fn.I1 = (fun h -> 4) }) + [@ns.braces ])) } let bracesFun = { Js.Fn.I1 = (fun x -> ((fun y -> x + y)[@ns.braces ])) } +let cFun2 x y = 3 +let uFun2 = { Js.Fn.I2 = (fun x -> fun y -> 3) } +let cFun2Dots x y = 3 type nonrec cTyp = string -> int type nonrec uTyp = (string -> int) Js.Fn.arity1 type nonrec mixTyp = diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index 3216f31c2c..2ef9e94b91 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -3,10 +3,10 @@ let uApp = foo(. 3) let cFun = x => 3 let uFun = (.x) => 3 -//let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 let bracesFun = (. x) => y => x+y -// let cFun2 = (x, y) => 3 -// let uFun2 = (. x, y) => 3 +let cFun2 = (x, y) => 3 +let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int @@ -22,10 +22,11 @@ let uApp = foo(3) let cFun = (. x) => 3 let uFun = x => 3 -// let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +let mixFun = (.a) => (b, c) => (.d, e, f) => (.g) => h => 4 let bracesFun = x => (. y) => x+y -// let cFun2 = (. x, y) => 3 -// let uFun2 = (x, y) => 3 +let cFun2 = (. x, y) => 3 +let uFun2 = (x, y) => 3 +let cFun2Dots = (.x, .y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index 0e6c8b34ac..6f5eb6034c 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -3,10 +3,10 @@ let uApp = foo(. 3) let cFun = x => 3 let uFun = (. x) => 3 -//let mixFun = (a, .b, c) => (d, e, f) => (g, .h) => 4 +let mixFun = a => (. b, c) => {(d, e, f, g) => (. h) => 4} let bracesFun = (. x) => {y => x + y} -// let cFun2 = (x, y) => 3 -// let uFun2 = (. x, y) => 3 +let cFun2 = (x, y) => 3 +let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int @@ -22,10 +22,11 @@ let uApp = foo(3) let cFun = (. x) => 3 let uFun = x => 3 -// let mixFun = (.a, b, .c) => (.d, .e, .f) => (.g, h) => 4 +let mixFun = (. a) => (b, c) => {(. d, e, f, g) => h => 4} let bracesFun = x => {(. y) => x + y} -// let cFun2 = (. x, y) => 3 -// let uFun2 = (x, y) => 3 +let cFun2 = (. x, y) => 3 +let uFun2 = (x, y) => 3 +let cFun2Dots = (. x, y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int From 332cbeab93804aed859cfdf43270df3785c34957 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 15:02:15 +0100 Subject: [PATCH 13/16] Fix uncurried type of multiple args --- lib/4.06.1/unstable/js_playground_compiler.ml | 30 +++++++++++-------- lib/4.06.1/whole_compiler.ml | 30 +++++++++++-------- res_syntax/src/res_core.ml | 30 +++++++++++-------- .../expressions/UncurriedByDefault.res | 10 +++---- .../expected/UncurriedByDefault.res.txt | 6 +++- .../tests/printer/expr/UncurriedByDefault.res | 12 ++++---- .../expr/expected/UncurriedByDefault.res.txt | 12 ++++---- 7 files changed, 73 insertions(+), 57 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 5cf044069e..e3818abba7 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -166495,13 +166495,13 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let typ = + let _paramNum, typ = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -166514,17 +166514,21 @@ and parseEs6ArrowType ~attrs p = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in - Ast_helper.Typ.constr ~loc - { - txt = - Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); - loc; - } - [tArg] + ( paramNum - 1, + Ast_helper.Typ.constr ~loc + { + txt = + Ldot + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + loc; + } + [tArg] ) else - Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ - t) - parameters returnType + ( paramNum - 1, + Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl + typ t )) + parameters + (List.length parameters, returnType) in { typ with diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 061104e4a8..622fdc3412 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -179927,13 +179927,13 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let typ = + let _paramNum, typ = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -179946,17 +179946,21 @@ and parseEs6ArrowType ~attrs p = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in - Ast_helper.Typ.constr ~loc - { - txt = - Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); - loc; - } - [tArg] + ( paramNum - 1, + Ast_helper.Typ.constr ~loc + { + txt = + Ldot + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + loc; + } + [tArg] ) else - Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ - t) - parameters returnType + ( paramNum - 1, + Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl + typ t )) + parameters + (List.length parameters, returnType) in { typ with diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 5c6c1cba39..208677ba41 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -4232,13 +4232,13 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let typ = + let _paramNum, typ = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} t -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in - if uncurried then + if uncurried && (paramNum = 1 || not p.uncurried_by_default) then let isUnit = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> true @@ -4251,17 +4251,21 @@ and parseEs6ArrowType ~attrs p = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in - Ast_helper.Typ.constr ~loc - { - txt = - Ldot (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); - loc; - } - [tArg] + ( paramNum - 1, + Ast_helper.Typ.constr ~loc + { + txt = + Ldot + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + loc; + } + [tArg] ) else - Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ - t) - parameters returnType + ( paramNum - 1, + Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl + typ t )) + parameters + (List.length parameters, returnType) in { typ with diff --git a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res index 8a546b80e7..92d1b7e697 100644 --- a/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res +++ b/res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res @@ -12,8 +12,8 @@ type cTyp = string => int type uTyp = (. string) => int type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int type bTyp = (. string) => string => int -// type cTyp2 = (string, string) => int -// type uTyp2 = (.string, string) => int +type cTyp2 = (string, string) => int +type uTyp2 = (.string, string) => int @@uncurried @@ -30,7 +30,7 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int -type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int type bTyp = string => (. string) => int -// type cTyp2 = (.string, string) => int -// type uTyp2 = (string, string) => int +type cTyp2 = (.string, string) => int +type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 544934cd40..7bc06d9a93 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -22,6 +22,8 @@ type nonrec mixTyp = string -> string -> string -> string -> (string -> int) Js.Fn.arity1) Js.Fn.arity6 type nonrec bTyp = (string -> string -> int) Js.Fn.arity2 +type nonrec cTyp2 = string -> string -> int +type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 [@@@uncurried ] let cApp = foo 3 let uApp = ((foo 3)[@bs ]) @@ -47,4 +49,6 @@ type nonrec mixTyp = string -> string -> string -> string -> string -> (string -> int) Js.Fn.arity1) Js.Fn.arity6 -type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 \ No newline at end of file +type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 +type nonrec cTyp2 = string -> string -> int +type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 \ No newline at end of file diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index 2ef9e94b91..7f1fa857ba 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -11,9 +11,9 @@ let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int -type bTyp = (. string) => string => int -// type cTyp2 = (string, string) => int -// type uTyp2 = (.string, string) => int +// type bTyp = (. string) => string => int +type cTyp2 = (string, string) => int +type uTyp2 = (.string, string) => int @@uncurried @@ -30,7 +30,7 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int -// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int // type bTyp = string => (. string) => int -// type cTyp2 = (. string, string) => int -// type uTyp2 = (string, string) => int +type cTyp2 = (. string, string) => int +type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index 6f5eb6034c..6369d1222e 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -11,9 +11,9 @@ let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int type mixTyp = string => (. string, string, string, string, string, string) => (. string) => int -type bTyp = (. string, string) => int -// type cTyp2 = (string, string) => int -// type uTyp2 = (.string, string) => int +// type bTyp = (. string) => string => int +type cTyp2 = (string, string) => int +type uTyp2 = (. string, string) => int @@uncurried @@ -30,7 +30,7 @@ let cFun2Dots = (. x, y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int -// type mixTyp = (.string, string, .string) => (.string, .string, .string) => (.string, string) => int +type mixTyp = (. string) => (string, string, string, string, string, string) => string => int // type bTyp = string => (. string) => int -// type cTyp2 = (. string, string) => int -// type uTyp2 = (string, string) => int +type cTyp2 = (. string, string) => int +type uTyp2 = (string, string) => int From 3636180cd83067fb4d8842ad54a6681a15e3e43f Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 15:29:32 +0100 Subject: [PATCH 14/16] Parsing: fix arity of curried after uncurried in types --- lib/4.06.1/unstable/js_playground_compiler.ml | 28 +++++++++++++------ lib/4.06.1/whole_compiler.ml | 28 +++++++++++++------ res_syntax/src/res_core.ml | 28 +++++++++++++------ .../expected/UncurriedByDefault.res.txt | 6 ++-- .../typexpr/expected/uncurried.res.txt | 4 +-- 5 files changed, 62 insertions(+), 32 deletions(-) diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index e3818abba7..26b90b57ce 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -166495,9 +166495,19 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let _paramNum, typ = + let returnTypeArity = + match parameters with + | _ when p.uncurried_by_default -> 0 + | _ -> + if parameters |> List.exists (function {dotted; typ = _} -> dotted) + then 0 + else + let _, args, _ = Res_parsetree_viewer.arrowType returnType in + List.length args + in + let _paramNum, typ, _arity = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in @@ -166507,10 +166517,8 @@ and parseEs6ArrowType ~attrs p = | Ptyp_constr ({txt = Lident "unit"}, []) -> true | _ -> false in - let _, args, _ = Res_parsetree_viewer.arrowType t in - let arity = 1 + List.length args in let loc = mkLoc startPos endPos in - let arity, tArg = + let fnArity, tArg = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in @@ -166519,16 +166527,18 @@ and parseEs6ArrowType ~attrs p = { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); loc; } - [tArg] ) + [tArg], + 1 ) else ( paramNum - 1, Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl - typ t )) + typ t, + arity + 1 )) parameters - (List.length parameters, returnType) + (List.length parameters, returnType, returnTypeArity + 1) in { typ with diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index 622fdc3412..eb7f2132ed 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -179927,9 +179927,19 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let _paramNum, typ = + let returnTypeArity = + match parameters with + | _ when p.uncurried_by_default -> 0 + | _ -> + if parameters |> List.exists (function {dotted; typ = _} -> dotted) + then 0 + else + let _, args, _ = Res_parsetree_viewer.arrowType returnType in + List.length args + in + let _paramNum, typ, _arity = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in @@ -179939,10 +179949,8 @@ and parseEs6ArrowType ~attrs p = | Ptyp_constr ({txt = Lident "unit"}, []) -> true | _ -> false in - let _, args, _ = Res_parsetree_viewer.arrowType t in - let arity = 1 + List.length args in let loc = mkLoc startPos endPos in - let arity, tArg = + let fnArity, tArg = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in @@ -179951,16 +179959,18 @@ and parseEs6ArrowType ~attrs p = { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); loc; } - [tArg] ) + [tArg], + 1 ) else ( paramNum - 1, Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl - typ t )) + typ t, + arity + 1 )) parameters - (List.length parameters, returnType) + (List.length parameters, returnType, returnTypeArity + 1) in { typ with diff --git a/res_syntax/src/res_core.ml b/res_syntax/src/res_core.ml index 208677ba41..ea9532e84c 100644 --- a/res_syntax/src/res_core.ml +++ b/res_syntax/src/res_core.ml @@ -4232,9 +4232,19 @@ and parseEs6ArrowType ~attrs p = Parser.expect EqualGreater p; let returnType = parseTypExpr ~alias:false p in let endPos = p.prevEndPos in - let _paramNum, typ = + let returnTypeArity = + match parameters with + | _ when p.uncurried_by_default -> 0 + | _ -> + if parameters |> List.exists (function {dotted; typ = _} -> dotted) + then 0 + else + let _, args, _ = Res_parsetree_viewer.arrowType returnType in + List.length args + in + let _paramNum, typ, _arity = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t) -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) -> let uncurried = if p.uncurried_by_default then not dotted else dotted in @@ -4244,10 +4254,8 @@ and parseEs6ArrowType ~attrs p = | Ptyp_constr ({txt = Lident "unit"}, []) -> true | _ -> false in - let _, args, _ = Res_parsetree_viewer.arrowType t in - let arity = 1 + List.length args in let loc = mkLoc startPos endPos in - let arity, tArg = + let fnArity, tArg = if isUnit && arity = 1 then (0, t) else (arity, Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t) in @@ -4256,16 +4264,18 @@ and parseEs6ArrowType ~attrs p = { txt = Ldot - (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int arity); + (Ldot (Lident "Js", "Fn"), "arity" ^ string_of_int fnArity); loc; } - [tArg] ) + [tArg], + 1 ) else ( paramNum - 1, Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl - typ t )) + typ t, + arity + 1 )) parameters - (List.length parameters, returnType) + (List.length parameters, returnType, returnTypeArity + 1) in { typ with diff --git a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt index 7bc06d9a93..102224bc38 100644 --- a/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt @@ -20,8 +20,8 @@ type nonrec mixTyp = (string -> string -> string -> string -> string -> string -> (string -> int) Js.Fn.arity1) - Js.Fn.arity6 -type nonrec bTyp = (string -> string -> int) Js.Fn.arity2 + Js.Fn.arity2 +type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 type nonrec cTyp2 = string -> string -> int type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 [@@@uncurried ] @@ -48,7 +48,7 @@ type nonrec mixTyp = (string -> string -> string -> string -> string -> string -> (string -> int) Js.Fn.arity1) - Js.Fn.arity6 + Js.Fn.arity2 type nonrec bTyp = (string -> string -> int) Js.Fn.arity1 type nonrec cTyp2 = string -> string -> int type nonrec uTyp2 = (string -> string -> int) Js.Fn.arity2 \ No newline at end of file diff --git a/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt b/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt index a1fefd1721..d1e5009181 100644 --- a/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt +++ b/res_syntax/tests/parsing/grammar/typexpr/expected/uncurried.res.txt @@ -9,8 +9,8 @@ type nonrec t = type nonrec t = (((float -> ((int)[@attr2 ]) -> - (((bool -> ((string)[@attr4 ]) -> unit) Js.Fn.arity2)[@attr3 ])) - Js.Fn.arity2)[@attr ]) + (((bool -> ((string)[@attr4 ]) -> unit) Js.Fn.arity1)[@attr3 ])) + Js.Fn.arity1)[@attr ]) type nonrec t = (((float)[@attr ]) -> ((int)[@attr2 ]) -> From 8bac9a83706ea01ee43f2f66f55d587efbb36ee1 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 15:51:00 +0100 Subject: [PATCH 15/16] Preserve uncurried after curried when printing types. E.g. `(. int) => string => bool` --- lib/4.06.1/unstable/js_compiler.ml | 28 ++++++++++++------- lib/4.06.1/unstable/js_playground_compiler.ml | 28 ++++++++++++------- lib/4.06.1/whole_compiler.ml | 28 ++++++++++++------- res_syntax/src/res_parsetree_viewer.ml | 13 +++++---- res_syntax/src/res_parsetree_viewer.mli | 1 + res_syntax/src/res_printer.ml | 14 +++++++--- .../tests/printer/expr/UncurriedByDefault.res | 4 +-- .../expr/expected/UncurriedByDefault.res.txt | 8 +++--- .../printer/expr/expected/asyncAwait.res.txt | 2 +- 9 files changed, 79 insertions(+), 47 deletions(-) diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 285770448f..f8bcd0345a 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -49384,6 +49384,7 @@ module Res_parsetree_viewer : sig * The parsetree contains: a => b => c => d, for printing purposes * we restructure the tree into (a, b, c) and its returnType d *) val arrowType : + ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list @@ -49540,15 +49541,16 @@ end = struct #1 "res_parsetree_viewer.ml" open Parsetree -let arrowType ct = - let rec process attrsBefore acc typ = +let arrowType ?(arity = max_int) ct = + let rec process attrsBefore acc typ arity = match typ with + | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | { ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = [({txt = "bs"}, _)]; @@ -49565,14 +49567,14 @@ let arrowType ct = ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> - process attrs [] {typ with ptyp_attributes = []} - | typ -> process [] [] typ + process attrs [] {typ with ptyp_attributes = []} arity + | typ -> process [] [] typ arity let functorType modtype = let rec process acc modtype = @@ -54612,8 +54614,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = ]) and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = - let printArrow ~uncurried typExpr = - let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in + let printArrow ~uncurried ?(arity = max_int) typExpr = + let attrsBefore, args, returnType = + ParsetreeViewer.arrowType ~arity typExpr + in let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in @@ -54718,12 +54722,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in let tUnit = Ast_helper.Typ.constr unitConstr [] in - printArrow ~uncurried:true + printArrow ~uncurried:true ~arity:1 {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> - printArrow ~uncurried:true tArg + let arity = + int_of_string + ((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5)) + in + printArrow ~uncurried:true ~arity tArg | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) -> (* for foo<{"a": b}>, when the object is long and needs a line break, we diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml index 26b90b57ce..81bbc0bb22 100644 --- a/lib/4.06.1/unstable/js_playground_compiler.ml +++ b/lib/4.06.1/unstable/js_playground_compiler.ml @@ -49384,6 +49384,7 @@ module Res_parsetree_viewer : sig * The parsetree contains: a => b => c => d, for printing purposes * we restructure the tree into (a, b, c) and its returnType d *) val arrowType : + ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list @@ -49540,15 +49541,16 @@ end = struct #1 "res_parsetree_viewer.ml" open Parsetree -let arrowType ct = - let rec process attrsBefore acc typ = +let arrowType ?(arity = max_int) ct = + let rec process attrsBefore acc typ arity = match typ with + | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | { ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = [({txt = "bs"}, _)]; @@ -49565,14 +49567,14 @@ let arrowType ct = ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> - process attrs [] {typ with ptyp_attributes = []} - | typ -> process [] [] typ + process attrs [] {typ with ptyp_attributes = []} arity + | typ -> process [] [] typ arity let functorType modtype = let rec process acc modtype = @@ -54612,8 +54614,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = ]) and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = - let printArrow ~uncurried typExpr = - let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in + let printArrow ~uncurried ?(arity = max_int) typExpr = + let attrsBefore, args, returnType = + ParsetreeViewer.arrowType ~arity typExpr + in let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in @@ -54718,12 +54722,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in let tUnit = Ast_helper.Typ.constr unitConstr [] in - printArrow ~uncurried:true + printArrow ~uncurried:true ~arity:1 {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> - printArrow ~uncurried:true tArg + let arity = + int_of_string + ((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5)) + in + printArrow ~uncurried:true ~arity tArg | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) -> (* for foo<{"a": b}>, when the object is long and needs a line break, we diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index eb7f2132ed..9cb3b3dbdd 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -104379,6 +104379,7 @@ module Res_parsetree_viewer : sig * The parsetree contains: a => b => c => d, for printing purposes * we restructure the tree into (a, b, c) and its returnType d *) val arrowType : + ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list @@ -104535,15 +104536,16 @@ end = struct #1 "res_parsetree_viewer.ml" open Parsetree -let arrowType ct = - let rec process attrsBefore acc typ = +let arrowType ?(arity = max_int) ct = + let rec process attrsBefore acc typ arity = match typ with + | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | { ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = [({txt = "bs"}, _)]; @@ -104560,14 +104562,14 @@ let arrowType ct = ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> - process attrs [] {typ with ptyp_attributes = []} - | typ -> process [] [] typ + process attrs [] {typ with ptyp_attributes = []} arity + | typ -> process [] [] typ arity let functorType modtype = let rec process acc modtype = @@ -109607,8 +109609,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = ]) and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = - let printArrow ~uncurried typExpr = - let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in + let printArrow ~uncurried ?(arity = max_int) typExpr = + let attrsBefore, args, returnType = + ParsetreeViewer.arrowType ~arity typExpr + in let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in @@ -109713,12 +109717,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in let tUnit = Ast_helper.Typ.constr unitConstr [] in - printArrow ~uncurried:true + printArrow ~uncurried:true ~arity:1 {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> - printArrow ~uncurried:true tArg + let arity = + int_of_string + ((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5)) + in + printArrow ~uncurried:true ~arity tArg | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) -> (* for foo<{"a": b}>, when the object is long and needs a line break, we diff --git a/res_syntax/src/res_parsetree_viewer.ml b/res_syntax/src/res_parsetree_viewer.ml index afa73cb68f..3b533d6953 100644 --- a/res_syntax/src/res_parsetree_viewer.ml +++ b/res_syntax/src/res_parsetree_viewer.ml @@ -1,14 +1,15 @@ open Parsetree -let arrowType ct = - let rec process attrsBefore acc typ = +let arrowType ?(arity = max_int) ct = + let rec process attrsBefore acc typ arity = match typ with + | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | { ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = [({txt = "bs"}, _)]; @@ -25,14 +26,14 @@ let arrowType ct = ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 (arity - 1) | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> - process attrs [] {typ with ptyp_attributes = []} - | typ -> process [] [] typ + process attrs [] {typ with ptyp_attributes = []} arity + | typ -> process [] [] typ arity let functorType modtype = let rec process acc modtype = diff --git a/res_syntax/src/res_parsetree_viewer.mli b/res_syntax/src/res_parsetree_viewer.mli index 9837a71850..d13d21537e 100644 --- a/res_syntax/src/res_parsetree_viewer.mli +++ b/res_syntax/src/res_parsetree_viewer.mli @@ -2,6 +2,7 @@ * The parsetree contains: a => b => c => d, for printing purposes * we restructure the tree into (a, b, c) and its returnType d *) val arrowType : + ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list diff --git a/res_syntax/src/res_printer.ml b/res_syntax/src/res_printer.ml index e6fa7cdadd..12d3606206 100644 --- a/res_syntax/src/res_printer.ml +++ b/res_syntax/src/res_printer.ml @@ -1548,8 +1548,10 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = ]) and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = - let printArrow ~uncurried typExpr = - let attrsBefore, args, returnType = ParsetreeViewer.arrowType typExpr in + let printArrow ~uncurried ?(arity = max_int) typExpr = + let attrsBefore, args, returnType = + ParsetreeViewer.arrowType ~arity typExpr + in let dotted, attrsBefore = (* Converting .ml code to .res requires processing uncurried attributes *) let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in @@ -1654,12 +1656,16 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl = | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), "arity0")}, [tArg]) -> let unitConstr = Location.mkloc (Longident.Lident "unit") tArg.ptyp_loc in let tUnit = Ast_helper.Typ.constr unitConstr [] in - printArrow ~uncurried:true + printArrow ~uncurried:true ~arity:1 {tArg with ptyp_desc = Ptyp_arrow (Nolabel, tUnit, tArg)} | Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Fn"), arity)}, [tArg]) when String.length arity >= 5 && (String.sub [@doesNotRaise]) arity 0 5 = "arity" -> - printArrow ~uncurried:true tArg + let arity = + int_of_string + ((String.sub [@doesNotRaise]) arity 5 (String.length arity - 5)) + in + printArrow ~uncurried:true ~arity tArg | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) -> (* for foo<{"a": b}>, when the object is long and needs a line break, we diff --git a/res_syntax/tests/printer/expr/UncurriedByDefault.res b/res_syntax/tests/printer/expr/UncurriedByDefault.res index 7f1fa857ba..ca654c2659 100644 --- a/res_syntax/tests/printer/expr/UncurriedByDefault.res +++ b/res_syntax/tests/printer/expr/UncurriedByDefault.res @@ -11,7 +11,7 @@ let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int type mixTyp = (string, .string, string) => (string, string, string) => (string, .string) => int -// type bTyp = (. string) => string => int +type bTyp = (. string) => string => int type cTyp2 = (string, string) => int type uTyp2 = (.string, string) => int @@ -31,6 +31,6 @@ let cFun2Dots = (.x, .y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int type mixTyp = (.string) => (string, string) => (.string, string, string, string) => string => int -// type bTyp = string => (. string) => int +type bTyp = string => (. string) => int type cTyp2 = (. string, string) => int type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt index 6369d1222e..f324439a67 100644 --- a/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt +++ b/res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt @@ -10,8 +10,8 @@ let uFun2 = (. x, y) => 3 type cTyp = string => int type uTyp = (. string) => int -type mixTyp = string => (. string, string, string, string, string, string) => (. string) => int -// type bTyp = (. string) => string => int +type mixTyp = string => (. string, string) => (string, string, string, string) => (. string) => int +type bTyp = (. string) => string => int type cTyp2 = (string, string) => int type uTyp2 = (. string, string) => int @@ -30,7 +30,7 @@ let cFun2Dots = (. x, y) => 3 // redundant dot on y type cTyp = (. string) => int type uTyp = string => int -type mixTyp = (. string) => (string, string, string, string, string, string) => string => int -// type bTyp = string => (. string) => int +type mixTyp = (. string) => (string, string) => (. string, string, string, string) => string => int +type bTyp = string => (. string) => int type cTyp2 = (. string, string) => int type uTyp2 = (string, string) => int diff --git a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt index 4a346a2b4b..68417533d1 100644 --- a/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt +++ b/res_syntax/tests/printer/expr/expected/asyncAwait.res.txt @@ -140,5 +140,5 @@ let c1 = @foo x => @bar y => x + y let c2 = (. x) => {y => x + y} let c3 = (. x) => {@foo y => x + y} -type t1 = (. int, string) => bool +type t1 = (. int) => string => bool type t2 = (. int, string) => bool From f964b6611fb77ea8cea4fd838340952c48e63b18 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 12 Nov 2022 16:24:32 +0100 Subject: [PATCH 16/16] Update changelog with description of experimental uncurried by default mode. --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6bca8b1f4b..eda17db2e0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,10 @@ # 11.0.0-alpha.1 +#### :rocket: New Feature + +- Introduce experimental uncurried by default mode. Can be turned on mid-file by adding standalone annotation `@@uncurried`. For experimentation only. https://github.com/rescript-lang/rescript-compiler/pull/5796 + #### :boom: Breaking Change - Remove support for the legacy Reason syntax. Existing Reason code can be converted to ReScript syntax using ReScript 9 as follows: