hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Change bounded search algorithm (change invariant)

pull/1/head
Lennart Spitzner 2016-08-06 22:27:30 +02:00
parent cd9474a969
commit b1f915d1c2
1 changed files with 18 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/Language/Haskell/Brittany/BriLayouter.hs
View File

@ -617,8 +617,10 @@ getSpacing !bridoc = rec bridoc
getSpacings :: forall m . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m) getSpacings :: forall m . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)
=> Int -> BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing] => Int -> BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
getSpacings limit bridoc = rec bridoc getSpacings limit bridoc = preFilterLimit <$> rec bridoc
where where
preFilterLimit :: [VerticalSpacing] -> [VerticalSpacing]
preFilterLimit = take (3*limit)
memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v
memoWithKey k v = Memo.memo (const v) k memoWithKey k v = Memo.memo (const v) k
rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing] rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
@ -631,16 +633,14 @@ 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 filterAndLimit = take limit
. take limit
. filter hasOkColCount . filter hasOkColCount
. take (100*limit) -- we need to limit here in case . preFilterLimit -- we need to limit here in case
-- that the input list is -- that the input list is
-- _large_ with a similarly _large_ -- _large_ with a similarly _large_
-- prefix not passing hasOkColCount -- prefix not passing hasOkColCount
-- predicate. -- predicate.
-- TODO: 100 is arbitrary. -- TODO: 3 is arbitrary.
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
BDFEmpty -> BDFEmpty ->
@ -648,9 +648,9 @@ getSpacings limit bridoc = rec bridoc
BDFLit t -> BDFLit t ->
return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False] return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
BDFSeq list -> BDFSeq list ->
filterAndLimit . fmap sumVs . sequence <$> rec `mapM` list fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
BDFCols _sig list -> BDFCols _sig list ->
filterAndLimit . fmap sumVs . sequence <$> rec `mapM` list fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list
BDFSeparator -> BDFSeparator ->
return $ [VerticalSpacing 1 VerticalSpacingParNone False] return $ [VerticalSpacing 1 VerticalSpacingParNone False]
BDFAddBaseY indent bd -> do BDFAddBaseY indent bd -> do
@ -689,14 +689,12 @@ getSpacings limit bridoc = rec bridoc
BDFIndentLevelPushCur bd -> rec bd BDFIndentLevelPushCur bd -> rec bd
BDFIndentLevelPop bd -> rec bd BDFIndentLevelPop bd -> rec bd
BDFPar BrIndentNone sameLine indented -> do BDFPar BrIndentNone sameLine indented -> do
mVss <- rec sameLine mVss <- filterAndLimit <$> rec sameLine
indSps <- rec indented indSps <- filterAndLimit <$> rec indented
let mVsIndSp = take limit let mVsIndSp = take limit
$ [ (x,y) $ [ (x,y)
| x<-mVss | x<-mVss
, y<-indSps , y<-indSps
, hasOkColCount x
, hasOkColCount y
] ]
return $ mVsIndSp <&> return $ mVsIndSp <&>
\(VerticalSpacing lsp mPsp _, indSp) -> \(VerticalSpacing lsp mPsp _, indSp) ->
@ -716,11 +714,11 @@ getSpacings limit bridoc = rec bridoc
BDFAlt [] -> error "empty BDAlt" BDFAlt [] -> error "empty BDAlt"
-- BDAlt (alt:_) -> rec alt -- BDAlt (alt:_) -> rec alt
BDFAlt alts -> do BDFAlt alts -> do
r <- filterAndLimit . join <$> (rec `mapM` alts) r <- rec `mapM` alts
return r return $ filterAndLimit =<< r
BDFForceMultiline bd -> rec bd BDFForceMultiline bd -> rec bd
BDFForceSingleline bd -> do BDFForceSingleline bd -> do
mVs <- rec bd mVs <- filterAndLimit <$> rec bd
return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs
BDFForwardLineMode bd -> rec bd BDFForwardLineMode bd -> rec bd
BDFExternal{} -> BDFExternal{} ->
@ -735,7 +733,7 @@ getSpacings limit bridoc = rec bridoc
-- paragraph". That most importantly means that Lines should never -- paragraph". That most importantly means that Lines should never
-- be inserted anywhere but at the start of the line. A -- be inserted anywhere but at the start of the line. A
-- counterexample would be anything like Seq[Lit "foo", Lines]. -- counterexample would be anything like Seq[Lit "foo", Lines].
lSpss <- rec `mapM` ls lSpss <- fmap filterAndLimit <$> rec `mapM` ls
let worbled = fmap reverse let worbled = fmap reverse
$ sequence $ sequence
$ reverse $ reverse
@ -744,7 +742,7 @@ getSpacings limit bridoc = rec bridoc
VerticalSpacing (_vs_sameLine lSp1) VerticalSpacing (_vs_sameLine lSp1)
(spMakePar $ maxVs lSps) (spMakePar $ maxVs lSps)
False False
return $ filterAndLimit $ summed return $ summed
-- lSpss@(mVs:_) <- rec `mapM` ls -- lSpss@(mVs:_) <- rec `mapM` ls
-- return $ case Control.Lens.transposeOf traverse lSpss of -- TODO: we currently only -- return $ case Control.Lens.transposeOf traverse lSpss of -- TODO: we currently only
-- -- consider the first alternative for the -- -- consider the first alternative for the
@ -776,12 +774,12 @@ getSpacings limit bridoc = rec bridoc
mVs <- rec bd mVs <- rec bd
return $ mVs <&> \vs -> vs { _vs_parFlag = True } return $ mVs <&> \vs -> vs { _vs_parFlag = True }
BDFForceParSpacing bd -> do BDFForceParSpacing bd -> do
mVs <- rec bd mVs <- preFilterLimit <$> rec bd
return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ] return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ]
BDFProhibitMTEL bd -> rec bd BDFProhibitMTEL bd -> rec bd
BDFDebug s bd -> do BDFDebug s bd -> do
r <- rec bd r <- rec bd
tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show r tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r)
return r return r
#if INSERTTRACESGETSPACING #if INSERTTRACESGETSPACING
case brdc of case brdc of
@ -790,7 +788,7 @@ getSpacings limit bridoc = rec bridoc
_ -> mTell $ Seq.fromList ["getSpacing: visiting: " _ -> mTell $ Seq.fromList ["getSpacing: visiting: "
++ show {-(toConstr $ brdc)-} (briDocToDoc $ unwrapBriDocNumbered (0, brdc)) ++ show {-(toConstr $ brdc)-} (briDocToDoc $ unwrapBriDocNumbered (0, brdc))
, " -> " , " -> "
++ show result ++ show (take 9 result)
] ]
#endif #endif
return result return result