Skip to content

Commit

Permalink
Collect ColMultilineItem using continuation passing style. Fixes fspr…
Browse files Browse the repository at this point in the history 
…ojects#1839. (fsprojects#1840)
  • Loading branch information
@nojaf
nojaf authored Jul 24, 2021
1 parent 39decbe commit 5b2f748
Show file tree
Hide file tree
Showing 4 changed files with 190 additions and 47 deletions.
17 changes: 17 additions & 0 deletions src/Fantomas.Tests/LetBindingTests.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1972,3 +1972,20 @@ if kind = shiftFlag then
)
"""

[<Test>]
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)
70 changes: 70 additions & 0 deletions src/Fantomas.Tests/TypeDeclarationTests.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2826,3 +2826,73 @@ and [<CustomEquality ; NoComparison>] Bar<'context, 'a> =
}
}
"""

[<Test>]
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)

[<Test>]
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)

[<Test>]
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)

[<Test>]
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)
100 changes: 72 additions & 28 deletions src/Fantomas/CodePrinter.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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)

Expand All @@ -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
Expand All @@ -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 =
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -670,20 +699,27 @@ 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

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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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 =
Expand Down
50 changes: 31 additions & 19 deletions src/Fantomas/SourceParser.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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|_|) =
Expand Down

0 comments on commit 5b2f748

Please sign in to comment.