Remove CPP
Taylor Fausak
GitHub
parent
0c33d9a6fa
commit
d89cf0ad30
|
|
@ -1,11 +1,6 @@
|
|||
#define INSERTTRACES 0
|
||||
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
#if !INSERTTRACES
|
||||
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
|
||||
#endif
|
||||
|
||||
module Language.Haskell.Brittany.Internal.BackendUtils
|
||||
( layoutWriteAppend
|
||||
|
|
@ -58,13 +53,7 @@ traceLocal
|
|||
:: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m, Show a)
|
||||
=> a
|
||||
-> m ()
|
||||
#if INSERTTRACES
|
||||
traceLocal x = do
|
||||
mGet >>= tellDebugMessShow @LayoutState
|
||||
tellDebugMessShow x
|
||||
#else
|
||||
traceLocal _ = return ()
|
||||
#endif
|
||||
|
||||
|
||||
layoutWriteAppend
|
||||
|
|
@ -79,21 +68,12 @@ layoutWriteAppend t = do
|
|||
state <- mGet
|
||||
case _lstate_curYOrAddNewline state of
|
||||
Right i -> do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow (" inserted newlines: ", i)
|
||||
#endif
|
||||
replicateM_ i $ mTell $ Text.Builder.fromString $ "\n"
|
||||
Left{} -> do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow (" inserted no newlines")
|
||||
#endif
|
||||
return ()
|
||||
let spaces = case _lstate_addSepSpace state of
|
||||
Just i -> i
|
||||
Nothing -> 0
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow (" inserted spaces: ", spaces)
|
||||
#endif
|
||||
mTell $ Text.Builder.fromText $ Text.pack (replicate spaces ' ')
|
||||
mTell $ Text.Builder.fromText $ t
|
||||
mModify $ \s -> s
|
||||
|
|
@ -159,7 +139,7 @@ layoutWriteNewlineBlock = do
|
|||
-- mSet $ state
|
||||
-- { _lstate_addSepSpace = Just
|
||||
-- $ if isJust $ _lstate_addNewline state
|
||||
-- then i
|
||||
-- then i
|
||||
-- else _lstate_indLevelLinger state + i - _lstate_curY state
|
||||
-- }
|
||||
|
||||
|
|
@ -303,9 +283,6 @@ layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m
|
|||
, MonadMultiWriter (Seq String) m
|
||||
) => m ()
|
||||
layoutRemoveIndentLevelLinger = do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutRemoveIndentLevelLinger")
|
||||
#endif
|
||||
mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
|
||||
}
|
||||
|
||||
|
|
@ -318,9 +295,6 @@ layoutWithAddBaseCol
|
|||
=> m ()
|
||||
-> m ()
|
||||
layoutWithAddBaseCol m = do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutWithAddBaseCol")
|
||||
#endif
|
||||
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
||||
state <- mGet
|
||||
layoutBaseYPushInternal $ lstate_baseY state + amount
|
||||
|
|
@ -336,9 +310,6 @@ layoutWithAddBaseColBlock
|
|||
=> m ()
|
||||
-> m ()
|
||||
layoutWithAddBaseColBlock m = do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutWithAddBaseColBlock")
|
||||
#endif
|
||||
amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
|
||||
state <- mGet
|
||||
layoutBaseYPushInternal $ lstate_baseY state + amount
|
||||
|
|
@ -390,9 +361,6 @@ layoutWithAddBaseColN
|
|||
-> m ()
|
||||
-> m ()
|
||||
layoutWithAddBaseColN amount m = do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutWithAddBaseColN", amount)
|
||||
#endif
|
||||
state <- mGet
|
||||
layoutBaseYPushInternal $ lstate_baseY state + amount
|
||||
m
|
||||
|
|
@ -444,9 +412,6 @@ layoutAddSepSpace :: (MonadMultiState LayoutState m
|
|||
, MonadMultiWriter (Seq String) m)
|
||||
=> m ()
|
||||
layoutAddSepSpace = do
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutAddSepSpace")
|
||||
#endif
|
||||
state <- mGet
|
||||
mSet $ state
|
||||
{ _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state }
|
||||
|
|
@ -523,9 +488,6 @@ layoutWritePriorComments ast = do
|
|||
Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) key anns
|
||||
}
|
||||
return mAnn
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutWritePriorComments", ExactPrint.mkAnnKey ast, mAnn)
|
||||
#endif
|
||||
case mAnn of
|
||||
Nothing -> return ()
|
||||
Just priors -> do
|
||||
|
|
@ -559,9 +521,6 @@ layoutWritePostComments ast = do
|
|||
anns
|
||||
}
|
||||
return mAnn
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutWritePostComments", ExactPrint.mkAnnKey ast, mAnn)
|
||||
#endif
|
||||
case mAnn of
|
||||
Nothing -> return ()
|
||||
Just posts -> do
|
||||
|
|
@ -584,9 +543,6 @@ layoutIndentRestorePostComment = do
|
|||
state <- mGet
|
||||
let mCommentCol = _lstate_commentCol state
|
||||
let eCurYAddNL = _lstate_curYOrAddNewline state
|
||||
#if INSERTTRACES
|
||||
tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol)
|
||||
#endif
|
||||
mModify $ \s -> s { _lstate_commentCol = Nothing
|
||||
, _lstate_commentNewlines = 0
|
||||
}
|
||||
|
|
@ -604,7 +560,7 @@ layoutIndentRestorePostComment = do
|
|||
-- layoutWritePriorCommentsRestore x = do
|
||||
-- layoutWritePriorComments x
|
||||
-- layoutIndentRestorePostComment
|
||||
--
|
||||
--
|
||||
-- layoutWritePostCommentsRestore :: (Data.Data.Data ast,
|
||||
-- MonadMultiWriter Text.Builder.Builder m,
|
||||
-- MonadMultiState LayoutState m
|
||||
|
|
|
|||
|
|
@ -1,7 +1,3 @@
|
|||
#define INSERTTRACESALT 0
|
||||
#define INSERTTRACESALTVISIT 0
|
||||
#define INSERTTRACESGETSPACING 0
|
||||
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
|
|
@ -117,14 +113,6 @@ transformAlts =
|
|||
|
||||
rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] (MultiRWSS.MultiRWS r w (AltCurPos ': s)) BriDocNumbered
|
||||
rec bdX@(brDcId, brDc) = do
|
||||
#if INSERTTRACESALTVISIT
|
||||
do
|
||||
acp :: AltCurPos <- mGet
|
||||
tellDebugMess $ "transformAlts: visiting: " ++ case brDc of
|
||||
BDFAnnotationPrior annKey _ -> show (toConstr brDc, annKey, acp)
|
||||
BDFAnnotationRest annKey _ -> show (toConstr brDc, annKey, acp)
|
||||
_ -> show (toConstr brDc, acp)
|
||||
#endif
|
||||
let reWrap = (,) brDcId
|
||||
-- debugAcp :: AltCurPos <- mGet
|
||||
case brDc of
|
||||
|
|
@ -206,20 +194,10 @@ transformAlts =
|
|||
-- TODO: use COMPLETE pragma instead?
|
||||
lineCheck _ = error "ghc exhaustive check is insufficient"
|
||||
lconf <- _conf_layout <$> mAsk
|
||||
#if INSERTTRACESALT
|
||||
tellDebugMess $ "considering options with " ++ show (length alts, acp)
|
||||
#endif
|
||||
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
|
||||
(zip spacings alts
|
||||
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
|
||||
( hasSpace1 lconf acp vs && lineCheck vs, bd))
|
||||
#if INSERTTRACESALT
|
||||
zip spacings options `forM_` \(vs, (_, bd)) ->
|
||||
tellDebugMess $ " " ++ "spacing=" ++ show vs
|
||||
++ ",hasSpace1=" ++ show (hasSpace1 lconf acp vs)
|
||||
++ ",lineCheck=" ++ show (lineCheck vs)
|
||||
++ " " ++ show (toConstr bd)
|
||||
#endif
|
||||
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
|
||||
$ rec
|
||||
$ fromMaybe (-- trace ("choosing last") $
|
||||
|
|
@ -240,9 +218,6 @@ transformAlts =
|
|||
AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
|
||||
AltLineModeStateContradiction -> False
|
||||
lconf <- _conf_layout <$> mAsk
|
||||
#if INSERTTRACESALT
|
||||
tellDebugMess $ "considering options with " ++ show (length alts, acp)
|
||||
#endif
|
||||
let options = -- trace ("considering options:" ++ show (length alts, acp)) $
|
||||
(zip spacings alts
|
||||
<&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
|
||||
|
|
@ -250,14 +225,6 @@ transformAlts =
|
|||
&& any lineCheck vs, bd))
|
||||
let checkedOptions :: [Maybe (Int, BriDocNumbered)] =
|
||||
zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ])
|
||||
#if INSERTTRACESALT
|
||||
zip spacings options `forM_` \(vs, (_, bd)) ->
|
||||
tellDebugMess $ " " ++ "spacing=" ++ show vs
|
||||
++ ",hasSpace2=" ++ show (hasSpace2 lconf acp <$> vs)
|
||||
++ ",lineCheck=" ++ show (lineCheck <$> vs)
|
||||
++ " " ++ show (toConstr bd)
|
||||
tellDebugMess $ " " ++ show (Data.Maybe.mapMaybe (fmap fst) checkedOptions)
|
||||
#endif
|
||||
id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x)
|
||||
$ rec
|
||||
$ fromMaybe (-- trace ("choosing last") $
|
||||
|
|
@ -510,9 +477,6 @@ getSpacing !bridoc = rec bridoc
|
|||
r <- rec bd
|
||||
tellDebugMess $ "getSpacing: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): mVs=" ++ show r
|
||||
return r
|
||||
#if INSERTTRACESGETSPACING
|
||||
tellDebugMess $ "getSpacing: visiting: " ++ show (toConstr $ brDc) ++ " -> " ++ show result
|
||||
#endif
|
||||
return result
|
||||
maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
|
||||
maxVs = foldl'
|
||||
|
|
@ -867,16 +831,6 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
|
|||
r <- rec bd
|
||||
tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r)
|
||||
return r
|
||||
#if INSERTTRACESGETSPACING
|
||||
case brdc of
|
||||
BDFAnnotationPrior{} -> return ()
|
||||
BDFAnnotationRest{} -> return ()
|
||||
_ -> mTell $ Seq.fromList ["getSpacings: visiting: "
|
||||
++ show (toConstr $ brdc) -- (briDocToDoc $ unwrapBriDocNumbered (0, brdc))
|
||||
, " -> "
|
||||
++ show (take 9 result)
|
||||
]
|
||||
#endif
|
||||
return result
|
||||
maxVs :: [VerticalSpacing] -> VerticalSpacing
|
||||
maxVs = foldl'
|
||||
|
|
|
|||
Loading…
Reference in New Issue