From 5b2f74821cf4b7d74d7d32fd504d2dd79506859f Mon Sep 17 00:00:00 2001 From: Florian Verdonck Date: Sat, 24 Jul 2021 09:39:24 +0200 Subject: [PATCH] Collect ColMultilineItem using continuation passing style. Fixes #1839. (#1840) --- src/Fantomas.Tests/LetBindingTests.fs | 17 ++++ src/Fantomas.Tests/TypeDeclarationTests.fs | 70 +++++++++++++++ src/Fantomas/CodePrinter.fs | 100 +++++++++++++++------ src/Fantomas/SourceParser.fs | 50 +++++++---- 4 files changed, 190 insertions(+), 47 deletions(-) diff --git a/src/Fantomas.Tests/LetBindingTests.fs b/src/Fantomas.Tests/LetBindingTests.fs index 22f3947efb..d6e358f7a6 100644 --- a/src/Fantomas.Tests/LetBindingTests.fs +++ b/src/Fantomas.Tests/LetBindingTests.fs @@ -1972,3 +1972,20 @@ if kind = shiftFlag then ) """ + +[] +let ``a huge amount of inner let bindings`` () = + let sourceCode = + List.init 1000 (fun i -> sprintf " let x%i = %i\n printfn \"%i\" x%i" i i i i) + |> String.concat "\n" + |> sprintf + """module A.Whole.Lot.Of.InnerLetBindings + +let v = +%s +""" + + let formatted = + formatSourceString false sourceCode config + + formatted |> should not' (equal EmptyString) diff --git a/src/Fantomas.Tests/TypeDeclarationTests.fs b/src/Fantomas.Tests/TypeDeclarationTests.fs index 3f155c1a2f..f687425466 100644 --- a/src/Fantomas.Tests/TypeDeclarationTests.fs +++ b/src/Fantomas.Tests/TypeDeclarationTests.fs @@ -2826,3 +2826,73 @@ and [] Bar<'context, 'a> = } } """ + +[] +let ``a huge amount of type declarations`` () = + let sourceCode = + List.init 1000 (sprintf "type FooBar%i = class end") + |> String.concat "\n" + |> sprintf + """module A.Whole.Lot.Of.Types + +%s + """ + + let formatted = + formatSourceString false sourceCode config + + // the result is less important here, + // the point of this unit test is to verify if a stackoverflow problem at genModuleDeclList has been resolved. + formatted |> should not' (equal EmptyString) + +[] +let ``a huge amount of type declarations, signature file`` () = + let sourceCode = + List.init 1000 (sprintf "type FooBar%i = class end") + |> String.concat "\n" + |> sprintf + """module A.Whole.Lot.Of.Types + +%s + """ + + let formatted = + formatSourceString true sourceCode config + + formatted |> should not' (equal EmptyString) + +[] +let ``a huge amount of member bindings`` () = + let sourceCode = + List.init 1000 (sprintf " member this.Bar%i () = ()") + |> String.concat "\n" + |> sprintf + """module A.Whole.Lot.Of.MemberBindings + +type FooBarry = + interface Lorem with +%s +""" + + let formatted = + formatSourceString false sourceCode config + + formatted |> should not' (equal EmptyString) + +[] +let ``a huge amount of member bindings, object expression`` () = + let sourceCode = + List.init 1000 (sprintf " member this.Bar%i () = ()") + |> String.concat "\n" + |> sprintf + """module A.Whole.Lot.Of.MemberBindings + +let leBarry = + { new SomeLargeInterface with +%s } +""" + + let formatted = + formatSourceString false sourceCode config + + formatted |> should not' (equal EmptyString) diff --git a/src/Fantomas/CodePrinter.fs b/src/Fantomas/CodePrinter.fs index e1cea0c6f5..44ac98928a 100644 --- a/src/Fantomas/CodePrinter.fs +++ b/src/Fantomas/CodePrinter.fs @@ -192,9 +192,12 @@ and genSigModuleOrNamespace astContext (SigModuleOrNamespace (ats, px, ao, lids, +> genSigModuleDeclList astContext mds and genModuleDeclList astContext e = - let rec collectItems e : ColMultilineItem list = + let rec collectItems + (e: SynModuleDecl list) + (finalContinuation: ColMultilineItem list -> ColMultilineItem list) + : ColMultilineItem list = match e with - | [] -> [] + | [] -> finalContinuation [] | OpenL (xs, ys) -> let expr = col sepNln xs (genModuleDecl astContext) @@ -203,7 +206,12 @@ and genModuleDeclList astContext e = let sepNln = sepNlnConsideringTriviaContentBeforeForMainNode SynModuleDecl_Open r - ColMultilineItem(expr, sepNln) :: collectItems ys + collectItems + ys + (fun ysItems -> + ColMultilineItem(expr, sepNln) :: ysItems + |> finalContinuation) + | HashDirectiveL (xs, ys) -> let expr = col sepNln xs (genModuleDecl astContext) @@ -212,7 +220,12 @@ and genModuleDeclList astContext e = let sepNln = sepNlnConsideringTriviaContentBeforeForMainNode SynModuleDecl_HashDirective r - ColMultilineItem(expr, sepNln) :: collectItems ys + collectItems + ys + (fun ysItems -> + ColMultilineItem(expr, sepNln) :: ysItems + |> finalContinuation) + | AttributesL (xs, y :: rest) -> let attrs = getRangesFromAttributesFromModuleDeclaration y @@ -227,8 +240,11 @@ and genModuleDeclList astContext e = let sepNln = sepNlnConsideringTriviaContentBeforeForMainNode SynModuleDecl_Attributes r - ColMultilineItem(expr, sepNln) - :: collectItems rest + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) | m :: rest -> let attrs = @@ -239,15 +255,21 @@ and genModuleDeclList astContext e = let expr = genModuleDecl astContext m - ColMultilineItem(expr, sepNln) - :: (collectItems rest) + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) - collectItems e |> colWithNlnWhenItemIsMultiline + collectItems e id |> colWithNlnWhenItemIsMultiline and genSigModuleDeclList astContext (e: SynModuleSigDecl list) = - let rec collectItems (e: SynModuleSigDecl list) : ColMultilineItem list = + let rec collectItems + (e: SynModuleSigDecl list) + (finalContinuation: ColMultilineItem list -> ColMultilineItem list) + : ColMultilineItem list = match e with - | [] -> [] + | [] -> finalContinuation [] | SigOpenL (xs, ys) -> let expr = col sepNln xs (genSigModuleDecl astContext) @@ -257,7 +279,11 @@ and genSigModuleDeclList astContext (e: SynModuleSigDecl list) = let sepNln = sepNlnConsideringTriviaContentBeforeForMainNode SynModuleSigDecl_Open r - ColMultilineItem(expr, sepNln) :: collectItems ys + collectItems + ys + (fun ysItems -> + ColMultilineItem(expr, sepNln) :: ysItems + |> finalContinuation) | s :: rest -> let attrs = getRangesFromAttributesFromSynModuleSigDeclaration s @@ -267,10 +293,13 @@ and genSigModuleDeclList astContext (e: SynModuleSigDecl list) = let expr = genSigModuleDecl astContext s - ColMultilineItem(expr, sepNln) - :: (collectItems rest) + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) - collectItems e |> colWithNlnWhenItemIsMultiline + collectItems e id |> colWithNlnWhenItemIsMultiline and genModuleDecl astContext (node: SynModuleDecl) = match node with @@ -670,9 +699,12 @@ and genPropertyWithGetSet astContext (b1, b2) rangeOfMember = | _ -> sepNone and genMemberBindingList astContext node = - let rec collectItems (node: SynBinding list) = + let rec collectItems + (node: SynBinding list) + (finalContinuation: ColMultilineItem list -> ColMultilineItem list) + : ColMultilineItem list = match node with - | [] -> [] + | [] -> finalContinuation [] | mb :: rest -> let expr = genMemberBinding astContext mb let r = mb.RangeOfBindingAndRhs @@ -680,10 +712,14 @@ and genMemberBindingList astContext node = let sepNln = sepNlnConsideringTriviaContentBeforeForMainNode (synBindingToFsAstType mb) r - ColMultilineItem(expr, sepNln) - :: (collectItems rest) + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) - collectItems node |> colWithNlnWhenItemIsMultiline + collectItems node id + |> colWithNlnWhenItemIsMultiline and genMemberBinding astContext b = match b with @@ -4459,9 +4495,12 @@ and genClauses astContext cs = /// Each multiline member definition has a pre and post new line. and genMemberDefnList astContext nodes = - let rec collectItems nodes = + let rec collectItems + (nodes: SynMemberDefn list) + (finalContinuation: ColMultilineItem list -> ColMultilineItem list) + : ColMultilineItem list = match nodes with - | [] -> [] + | [] -> finalContinuation [] | PropertyWithGetSetMemberDefn (gs, rest) -> let attrs = getRangesFromAttributesFromSynBinding (fst gs) @@ -4475,9 +4514,11 @@ and genMemberDefnList astContext nodes = let sepNln = sepNlnConsideringTriviaContentBeforeWithAttributesFor SynMemberDefn_Member rangeOfFirstMember attrs - ColMultilineItem(expr, sepNln) - :: (collectItems rest) - + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) | m :: rest -> let attrs = getRangesFromAttributesFromSynMemberDefinition m @@ -4487,10 +4528,13 @@ and genMemberDefnList astContext nodes = let sepNln = sepNlnConsideringTriviaContentBeforeWithAttributesFor (synMemberDefnToFsAstType m) m.Range attrs - ColMultilineItem(expr, sepNln) - :: (collectItems rest) + collectItems + rest + (fun restItems -> + ColMultilineItem(expr, sepNln) :: restItems + |> finalContinuation) - collectItems nodes + collectItems nodes id |> colWithNlnWhenItemIsMultilineUsingConfig and genMemberDefn astContext node = diff --git a/src/Fantomas/SourceParser.fs b/src/Fantomas/SourceParser.fs index 0b20dfe81e..7b9c378fa0 100644 --- a/src/Fantomas/SourceParser.fs +++ b/src/Fantomas/SourceParser.fs @@ -904,15 +904,20 @@ type ComputationExpressionStatement = | AndBangStatement of SynPat * SynExpr * range | OtherStatement of SynExpr -let rec collectComputationExpressionStatements e : ComputationExpressionStatement list = +let rec collectComputationExpressionStatements + (e: SynExpr) + (finalContinuation: ComputationExpressionStatement list -> ComputationExpressionStatement list) + : ComputationExpressionStatement list = match e with | LetOrUses (bindings, body) -> let letBindings = bindings |> List.map LetOrUseStatement - let returnExpr = - collectComputationExpressionStatements body - - letBindings @ returnExpr + collectComputationExpressionStatements + body + (fun bodyStatements -> + [ yield! letBindings + yield! bodyStatements ] + |> finalContinuation) | SynExpr.LetOrUseBang (_, isUse, _, pat, expr, andBangs, body, r) -> let letOrUseBang = LetOrUseBangStatement(isUse, pat, expr, r) @@ -921,26 +926,33 @@ let rec collectComputationExpressionStatements e : ComputationExpressionStatemen andBangs |> List.map (fun (_, _, _, ap, ae, andRange) -> AndBangStatement(ap, ae, andRange)) - let bodyStatements = - collectComputationExpressionStatements body - - [ letOrUseBang - yield! andBangs - yield! bodyStatements ] + collectComputationExpressionStatements + body + (fun bodyStatements -> + [ letOrUseBang + yield! andBangs + yield! bodyStatements ] + |> finalContinuation) | SynExpr.Sequential (_, _, e1, e2, _) -> - [ yield! collectComputationExpressionStatements e1 - yield! collectComputationExpressionStatements e2 ] - | expr -> [ OtherStatement expr ] + let continuations: ((ComputationExpressionStatement list -> ComputationExpressionStatement list) -> ComputationExpressionStatement list) list = + [ collectComputationExpressionStatements e1 + collectComputationExpressionStatements e2 ] + + let finalContinuation (nodes: ComputationExpressionStatement list list) : ComputationExpressionStatement list = + List.collect id nodes |> finalContinuation + + Continuation.sequence continuations finalContinuation + | expr -> finalContinuation [ OtherStatement expr ] /// Matches if the SynExpr has some or of computation expression member call inside. let rec (|CompExprBody|_|) expr = match expr with - | SynExpr.LetOrUse (_, _, _, CompExprBody _, _) -> Some(collectComputationExpressionStatements expr) - | SynExpr.LetOrUseBang _ -> Some(collectComputationExpressionStatements expr) - | SynExpr.Sequential (_, _, _, SynExpr.YieldOrReturn _, _) -> Some(collectComputationExpressionStatements expr) - | SynExpr.Sequential (_, _, _, SynExpr.LetOrUse _, _) -> Some(collectComputationExpressionStatements expr) + | SynExpr.LetOrUse (_, _, _, CompExprBody _, _) -> Some(collectComputationExpressionStatements expr id) + | SynExpr.LetOrUseBang _ -> Some(collectComputationExpressionStatements expr id) + | SynExpr.Sequential (_, _, _, SynExpr.YieldOrReturn _, _) -> Some(collectComputationExpressionStatements expr id) + | SynExpr.Sequential (_, _, _, SynExpr.LetOrUse _, _) -> Some(collectComputationExpressionStatements expr id) | SynExpr.Sequential (_, _, SynExpr.DoBang _, SynExpr.LetOrUseBang _, _) -> - Some(collectComputationExpressionStatements expr) + Some(collectComputationExpressionStatements expr id) | _ -> None let (|ForEach|_|) =