Change layouting for lambda, app; Fix exponential behaviour

pull/1/head
Lennart Spitzner 2016-08-06 19:36:47 +02:00
parent 0314569276
commit cd9474a969
2 changed files with 22 additions and 5 deletions

View File

@ -631,7 +631,15 @@ getSpacings limit bridoc = rec bridoc
VerticalSpacingParSome i -> i <= colMax VerticalSpacingParSome i -> i <= colMax
VerticalSpacingParNonBottom -> True VerticalSpacingParNonBottom -> True
let filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing] let filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing]
filterAndLimit = forceList . take limit . filter hasOkColCount filterAndLimit = forceList
. take limit
. filter hasOkColCount
. take (100*limit) -- we need to limit here in case
-- that the input list is
-- _large_ with a similarly _large_
-- prefix not passing hasOkColCount
-- predicate.
-- TODO: 100 is arbitrary.
forceList l = foldl (flip seq) l l forceList l = foldl (flip seq) l l
result <- case brdc of result <- case brdc of
-- BDWrapAnnKey _annKey bd -> rec bd -- BDWrapAnnKey _annKey bd -> rec bd
@ -730,7 +738,8 @@ getSpacings limit bridoc = rec bridoc
lSpss <- rec `mapM` ls lSpss <- rec `mapM` ls
let worbled = fmap reverse let worbled = fmap reverse
$ sequence $ sequence
$ reverse lSpss $ reverse
$ lSpss
summed = worbled <&> \lSps@(lSp1:_) -> summed = worbled <&> \lSps@(lSp1:_) ->
VerticalSpacing (_vs_sameLine lSp1) VerticalSpacing (_vs_sameLine lSp1)
(spMakePar $ maxVs lSps) (spMakePar $ maxVs lSps)

View File

@ -56,13 +56,15 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
docCols ColCasePattern docCols ColCasePattern
$ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator]))
docAlt docAlt
[ docSeq [ docSetParSpacing
$ docSeq
[ docLit $ Text.pack "\\" [ docLit $ Text.pack "\\"
, docWrapNode lmatch $ docForceSingleline funcPatternPartLine , docWrapNode lmatch $ docForceSingleline funcPatternPartLine
, appSep $ docLit $ Text.pack "->" , appSep $ docLit $ Text.pack "->"
, docWrapNode lgrhs $ docForceParSpacing bodyDoc , docWrapNode lgrhs $ docForceParSpacing bodyDoc
] ]
, docAddBaseY BrIndentRegular , docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docSeq (docSeq
[ docLit $ Text.pack "\\" [ docLit $ Text.pack "\\"
@ -120,6 +122,12 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
[ docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2] [ docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2]
, docSetParSpacing , docSetParSpacing
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docSeq
[ appSep $ docForceSingleline expDoc1
, docForceParSpacing expDoc2
]
, docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docForceSingleline expDoc1) (docForceSingleline expDoc1)
expDoc2 expDoc2
@ -472,7 +480,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
$ docAddBaseY BrIndentRegular $ docAddBaseY BrIndentRegular
$ docPar $ docPar
(docLit t) (docLit t)
(docLines $ let (docNonBottomSpacing $ docLines $ let
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docLit $ fd1n , appSep $ docLit $ fd1n