diff options
| author | Austin Seipp <austin@well-typed.com> | 2014-04-22 06:09:40 -0500 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2014-09-09 08:13:27 -0500 |
| commit | d94de87252d0fe2ae97341d186b03a2fbe136b04 (patch) | |
| tree | 1cac19f2786b1d8a1626886cd6373946a3a276b0 /compiler | |
| parent | fdfe6c0e50001add357475a1a3a7627243a28a70 (diff) | |
| download | haskell-d94de87252d0fe2ae97341d186b03a2fbe136b04.tar.gz | |
Make Applicative a superclass of Monad
Summary:
This includes pretty much all the changes needed to make `Applicative`
a superclass of `Monad` finally. There's mostly reshuffling in the
interests of avoid orphans and boot files, but luckily we can resolve
all of them, pretty much. The only catch was that
Alternative/MonadPlus also had to go into Prelude to avoid this.
As a result, we must update the hsc2hs and haddock submodules.
Signed-off-by: Austin Seipp <austin@well-typed.com>
Test Plan: Build things, they might not explode horribly.
Reviewers: hvr, simonmar
Subscribers: simonmar
Differential Revision: https://phabricator.haskell.org/D13
Diffstat (limited to 'compiler')
63 files changed, 234 insertions, 127 deletions
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index c582b783f2..188233d1ea 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -33,6 +33,10 @@ import Data.Bits import Data.List (nub) import Control.Monad (liftM) +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + #include "HsVersions.h" {- Note [Stack Layout] diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index 970ce68149..d329243ad7 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -5,7 +5,7 @@ -- CmmLint: checking the correctness of Cmm statements and expressions -- ----------------------------------------------------------------------------- -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs, CPP #-} module CmmLint ( cmmLint, cmmLintGraph ) where @@ -22,7 +22,9 @@ import DynFlags import Data.Maybe import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif -- Things to check: -- - invariant on CmmBlock in CmmExpr (see comment there) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index c25147cd82..9502d34378 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -54,7 +54,9 @@ import Data.Word import System.IO import qualified Data.Map as Map import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import qualified Data.Array.Unsafe as U ( castSTUArray ) import Data.Array.ST diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 4631b2dc14..444112f967 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -53,6 +53,10 @@ import DynFlags import Data.Maybe import Control.Monad +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + ------------------------------------------------------------------------ -- Top-level bindings ------------------------------------------------------------------------ diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index ad34b5ba19..b2b64f8650 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -48,6 +48,10 @@ import Outputable import Control.Monad (when,void) +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + ------------------------------------------------------------------------ -- cgExpr: the main function ------------------------------------------------------------------------ diff --git a/compiler/codeGen/StgCmmExtCode.hs b/compiler/codeGen/StgCmmExtCode.hs index 5f412b3cf8..931b55624b 100644 --- a/compiler/codeGen/StgCmmExtCode.hs +++ b/compiler/codeGen/StgCmmExtCode.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | Our extended FCode monad. -- We add a mapping from names to CmmExpr, to support local variable names in @@ -49,8 +51,9 @@ import UniqFM import Unique import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) - +#endif -- | The environment contains variable definitions or blockids. data Named diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index 6937c85d01..eb1c7da76d 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -41,7 +41,12 @@ import Outputable import BasicTypes import Control.Monad + +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding( succ, (<*>) ) +#else import Prelude hiding( succ ) +#endif ----------------------------------------------------------------------------- -- Code generation for Foreign Calls diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 7ac2c7a0bd..eca118fd25 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -47,6 +47,10 @@ import Module import DynFlags import FastString( mkFastString, fsLit ) +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + import Control.Monad (when) import Data.Maybe (isJust) diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index d62101f27e..af2d6619ea 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -25,6 +25,10 @@ module StgCmmLayout ( #include "HsVersions.h" +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + import StgCmmClosure import StgCmmEnv import StgCmmArgRep -- notably: ( slowCallPattern ) diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 22c89d7e05..57120cf5ce 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -393,7 +393,7 @@ addCodeBlocksFrom :: CgState -> CgState -> CgState -- Add code blocks from the latter to the former -- (The cgs_stmts will often be empty, but not always; see codeOnly) s1 `addCodeBlocksFrom` s2 - = s1 { cgs_stmts = cgs_stmts s1 <*> cgs_stmts s2, + = s1 { cgs_stmts = cgs_stmts s1 MkGraph.<*> cgs_stmts s2, cgs_tops = cgs_tops s1 `appOL` cgs_tops s2 } @@ -697,7 +697,7 @@ newLabelC = do { u <- newUnique emit :: CmmAGraph -> FCode () emit ag = do { state <- getState - ; setState $ state { cgs_stmts = cgs_stmts state <*> ag } } + ; setState $ state { cgs_stmts = cgs_stmts state MkGraph.<*> ag } } emitDecl :: CmmDecl -> FCode () emitDecl decl @@ -724,7 +724,7 @@ emitProcWithStackFrame _conv mb_info lbl _stk_args [] blocks False emitProcWithStackFrame conv mb_info lbl stk_args args blocks True -- do layout = do { dflags <- getDynFlags ; let (offset, live, entry) = mkCallEntry dflags conv args stk_args - ; emitProc_ mb_info lbl live (entry <*> blocks) offset True + ; emitProc_ mb_info lbl live (entry MkGraph.<*> blocks) offset True } emitProcWithStackFrame _ _ _ _ _ _ _ = panic "emitProcWithStackFrame" @@ -778,21 +778,21 @@ mkCmmIfThenElse e tbranch fbranch = do endif <- newLabelC tid <- newLabelC fid <- newLabelC - return $ mkCbranch e tid fid <*> - mkLabel tid <*> tbranch <*> mkBranch endif <*> - mkLabel fid <*> fbranch <*> mkLabel endif + return $ mkCbranch e tid fid MkGraph.<*> + mkLabel tid MkGraph.<*> tbranch MkGraph.<*> mkBranch endif MkGraph.<*> + mkLabel fid MkGraph.<*> fbranch MkGraph.<*> mkLabel endif mkCmmIfGoto :: CmmExpr -> BlockId -> FCode CmmAGraph mkCmmIfGoto e tid = do endif <- newLabelC - return $ mkCbranch e tid endif <*> mkLabel endif + return $ mkCbranch e tid endif MkGraph.<*> mkLabel endif mkCmmIfThen :: CmmExpr -> CmmAGraph -> FCode CmmAGraph mkCmmIfThen e tbranch = do endif <- newLabelC tid <- newLabelC - return $ mkCbranch e tid endif <*> - mkLabel tid <*> tbranch <*> mkLabel endif + return $ mkCbranch e tid endif MkGraph.<*> + mkLabel tid MkGraph.<*> tbranch MkGraph.<*> mkLabel endif mkCall :: CmmExpr -> (Convention, Convention) -> [CmmFormal] -> [CmmActual] @@ -803,7 +803,7 @@ mkCall f (callConv, retConv) results actuals updfr_off extra_stack = do let area = Young k (off, _, copyin) = copyInOflow dflags retConv area results [] copyout = mkCallReturnsTo dflags f callConv actuals k off updfr_off extra_stack - return (copyout <*> mkLabel k <*> copyin) + return (copyout MkGraph.<*> mkLabel k MkGraph.<*> copyin) mkCmmCall :: CmmExpr -> [CmmFormal] -> [CmmActual] -> UpdFrameOffset -> FCode CmmAGraph diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index e6f4e48425..a86caf1a9d 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -43,6 +43,10 @@ import FastString import Outputable import Util +#if __GLASGOW_HASKELL__ >= 709 +import Prelude hiding ((<*>)) +#endif + import Data.Bits ((.&.), bit) import Control.Monad (liftM, when) diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 985c6db900..d47a01661a 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -709,7 +709,7 @@ label_code :: BlockId -> CmmAGraph -> FCode BlockId -- and returns L label_code join_lbl code = do lbl <- newLabelC - emitOutOfLine lbl (code <*> mkBranch join_lbl) + emitOutOfLine lbl (code MkGraph.<*> mkBranch join_lbl) return lbl -------------- diff --git a/compiler/coreSyn/CoreLint.lhs b/compiler/coreSyn/CoreLint.lhs index 21e0b5fefd..f6bb1a280e 100644 --- a/compiler/coreSyn/CoreLint.lhs +++ b/compiler/coreSyn/CoreLint.lhs @@ -1283,7 +1283,7 @@ dumpLoc (CasePat (con, args, _)) dumpLoc (ImportedUnfolding locn) = (locn, brackets (ptext (sLit "in an imported unfolding"))) dumpLoc TopLevelBindings - = (noSrcLoc, empty) + = (noSrcLoc, Outputable.empty) dumpLoc (InType ty) = (noSrcLoc, text "In the type" <+> quotes (ppr ty)) dumpLoc (InCo co) diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index fae5f36426..5e7289f00c 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -1209,7 +1209,7 @@ static void hpc_init_Main(void) \begin{code} hpcInitCode :: Module -> HpcInfo -> SDoc -hpcInitCode _ (NoHpcInfo {}) = empty +hpcInitCode _ (NoHpcInfo {}) = Outputable.empty hpcInitCode this_mod (HpcInfo tickCount hashNo) = vcat [ text "static void hpc_init_" <> ppr this_mod diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 7b18b2e2b3..6844f48970 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -426,7 +426,7 @@ dsExpr (RecordCon (L _ data_con_id) con_expr rbinds) = do (rhs:rhss) -> ASSERT( null rhss ) dsLExpr rhs [] -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (ppr lbl) - unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty empty + unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty Outputable.empty labels = dataConFieldLabels (idDataCon data_con_id) -- The data_con_id is guaranteed to be the wrapper id of the constructor diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 38ed3af44f..f404997c9f 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -186,7 +186,7 @@ warnAboutOverflowedLiterals dflags lit , i > 0 , not (xopt Opt_NegativeLiterals dflags) = ptext (sLit "If you are trying to write a large negative literal, use NegativeLiterals") - | otherwise = empty + | otherwise = Outputable.empty \end{code} Note [Suggest NegativeLiterals] diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 52d6adde86..5a9cec2587 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -35,7 +35,9 @@ import Outputable import Platform import Util +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Control.Monad import Control.Monad.ST ( runST ) import Control.Monad.Trans.Class diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 645a0d8118..a6e80e5820 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -49,7 +49,9 @@ import Data.List import Foreign import Foreign.C +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Control.Monad import Data.Char diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index 7b841d5edc..c7c993503e 100644 --- a/compiler/hsSyn/Convert.lhs +++ b/compiler/hsSyn/Convert.lhs @@ -7,6 +7,7 @@ This module converts Template Haskell syntax into HsSyn \begin{code} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE CPP #-} module Convert( convertToHsExpr, convertToPat, convertToHsDecls, convertToHsType, @@ -36,7 +37,9 @@ import Outputable import qualified Data.ByteString as BS import Control.Monad( unless, liftM, ap ) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Language.Haskell.TH as TH hiding (sigP) import Language.Haskell.TH.Syntax as TH diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index e0176a52a0..5ebada6e9c 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -13,6 +13,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@. {-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types] -- in module PlaceHolder {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE CPP #-} module HsBinds where @@ -43,7 +44,11 @@ import Data.Ord import Data.Foldable ( Foldable(..) ) import Data.Traversable ( Traversable(..) ) import Data.Monoid ( mappend ) -import Control.Applicative ( (<$>), (<*>) ) +#if __GLASGOW_HASKELL__ < 709 +import Control.Applicative hiding (empty) +#else +import Control.Applicative ((<$>)) +#endif \end{code} %************************************************************************ diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 935b8eda93..6fec398582 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -608,10 +608,10 @@ showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr } ppShowIface :: ShowSub -> SDoc -> SDoc ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowIface _ _ = empty +ppShowIface _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc -ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = empty +ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool @@ -675,13 +675,13 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, _ -> ptext (sLit "instance") <+> pprIfaceTyConParent parent pp_roles - | is_data_instance = empty + | is_data_instance = Outputable.empty | otherwise = pprRoles (== Representational) (pprPrefixIfDeclBndr ss tycon) tc_tyvars roles -- Don't display roles for data family instances (yet) -- See discussion on Trac #8672. - add_bars [] = empty + add_bars [] = Outputable.empty add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs) ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc) @@ -716,7 +716,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, pp_extra = vcat [pprCType ctype, pprRec isrec, pp_prom] pp_prom | is_prom = ptext (sLit "Promotable") - | otherwise = empty + | otherwise = Outputable.empty pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec @@ -767,7 +767,7 @@ pprIfaceDecl ss (IfaceSyn { ifName = tycon, ifTyVars = tyvars pp_branches (IfaceClosedSynFamilyTyCon ax brs) = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs) $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax) - pp_branches _ = empty + pp_branches _ = Outputable.empty pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatWrapper = wrapper, ifPatIsInfix = is_infix, @@ -806,7 +806,7 @@ pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon pprCType :: Maybe CType -> SDoc -pprCType Nothing = empty +pprCType Nothing = Outputable.empty pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType -- if, for each role, suppress_if role is True, then suppress the role @@ -819,7 +819,7 @@ pprRoles suppress_if tyCon tyvars roles ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles) pprRec :: RecFlag -> SDoc -pprRec NonRecursive = empty +pprRec NonRecursive = Outputable.empty pprRec Recursive = ptext (sLit "RecFlag: Recursive") pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc @@ -843,7 +843,7 @@ pprIfaceAT :: ShowSub -> IfaceAT -> SDoc pprIfaceAT ss (IfaceAT d mb_def) = vcat [ pprIfaceDecl ss d , case mb_def of - Nothing -> empty + Nothing -> Outputable.empty Just rhs -> nest 2 $ ptext (sLit "Default:") <+> ppr rhs ] @@ -852,7 +852,7 @@ instance Outputable IfaceTyConParent where pprIfaceTyConParent :: IfaceTyConParent -> SDoc pprIfaceTyConParent IfNoParent - = empty + = Outputable.empty pprIfaceTyConParent (IfDataInstance _ tc tys) = sdocWithDynFlags $ \dflags -> let ftys = stripKindArgs dflags tys @@ -1071,13 +1071,15 @@ instance Outputable IfaceConAlt where ------------------ instance Outputable IfaceIdDetails where - ppr IfVanillaId = empty + ppr IfVanillaId = Outputable.empty ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc - <+> if b then ptext (sLit "<naughty>") else empty + <+> if b + then ptext (sLit "<naughty>") + else Outputable.empty ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns) instance Outputable IfaceIdInfo where - ppr NoInfo = empty + ppr NoInfo = Outputable.empty ppr (HasInfo is) = ptext (sLit "{-") <+> pprWithCommas ppr is <+> ptext (sLit "-}") @@ -1092,7 +1094,9 @@ instance Outputable IfaceInfoItem where instance Outputable IfaceUnfolding where ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e) - ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) + ppr (IfCoreUnfold s e) = (if s + then ptext (sLit "<stable>") + else Outputable.empty) <+> parens (ppr e) ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok), @@ -1511,7 +1515,7 @@ instance Binary IfaceSynTyConRhs where put_ bh IfaceAbstractClosedSynFamilyTyCon = putByte bh 2 put_ bh (IfaceSynonymTyCon ty) = putByte bh 3 >> put_ bh ty put_ _ IfaceBuiltInSynFamTyCon - = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" empty + = pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" Outputable.empty get bh = do { h <- getByte bh ; case h of @@ -1906,4 +1910,4 @@ instance Binary IfaceTyConParent where pr <- get bh ty <- get bh return $ IfDataInstance ax pr ty -\end{code}
\ No newline at end of file +\end{code} diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 2be6e9d4d8..fa6f603d8e 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -549,7 +549,7 @@ findAndReadIface doc_str mod hi_boot_file = do traceIf (sep [hsep [ptext (sLit "Reading"), if hi_boot_file then ptext (sLit "[boot]") - else empty, + else Outputable.empty, ptext (sLit "interface for"), ppr mod <> semi], nest 4 (ptext (sLit "reason:") <+> doc_str)]) @@ -736,9 +736,9 @@ pprModIface :: ModIface -> SDoc pprModIface iface = vcat [ ptext (sLit "interface") <+> ppr (mi_module iface) <+> pp_boot - <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty) - <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty) - <+> (if mi_hpc iface then ptext (sLit "[hpc]") else empty) + <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else Outputable.empty) + <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else Outputable.empty) + <+> (if mi_hpc iface then ptext (sLit "[hpc]") else Outputable.empty) <+> integer hiVersion , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface)) , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface)) @@ -764,7 +764,7 @@ pprModIface iface ] where pp_boot | mi_boot iface = ptext (sLit "[boot]") - | otherwise = empty + | otherwise = Outputable.empty \end{code} When printing export lists, we print like this: @@ -775,12 +775,12 @@ When printing export lists, we print like this: \begin{code} pprExport :: IfaceExport -> SDoc pprExport (Avail n) = ppr n -pprExport (AvailTC _ []) = empty +pprExport (AvailTC _ []) = Outputable.empty pprExport (AvailTC n (n':ns)) | n==n' = ppr n <> pp_export ns | otherwise = ppr n <> char '|' <> pp_export (n':ns) where - pp_export [] = empty + pp_export [] = Outputable.empty pp_export names = braces (hsep (map ppr names)) pprUsage :: Usage -> SDoc @@ -789,7 +789,7 @@ pprUsage usage@UsagePackageModule{} pprUsage usage@UsageHomeModule{} = pprUsageImport usage usg_mod_name $$ nest 2 ( - maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$ + maybe Outputable.empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$ vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ] ) pprUsage usage@UsageFile{} @@ -815,12 +815,12 @@ pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs, where ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot ppr_pkg (pkg,trust_req) = ppr pkg <> - (if trust_req then text "*" else empty) + (if trust_req then text "*" else Outputable.empty) ppr_boot True = text "[boot]" - ppr_boot False = empty + ppr_boot False = Outputable.empty pprFixities :: [(OccName, Fixity)] -> SDoc -pprFixities [] = empty +pprFixities [] = Outputable.empty pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes where pprFix (occ,fix) = ppr fix <+> ppr occ @@ -850,7 +850,7 @@ instance Outputable Warnings where ppr = pprWarns pprWarns :: Warnings -> SDoc -pprWarns NoWarnings = empty +pprWarns NoWarnings = Outputable.empty pprWarns (WarnAll txt) = ptext (sLit "Warn all") <+> ppr txt pprWarns (WarnSome prs) = ptext (sLit "Warnings") <+> vcat (map pprWarning prs) @@ -905,7 +905,7 @@ homeModError mod location = ptext (sLit "attempting to use module ") <> quotes (ppr mod) <> (case ml_hs_file location of Just file -> space <> parens (text file) - Nothing -> empty) + Nothing -> Outputable.empty) <+> ptext (sLit "which is not loaded") \end{code} diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 9b5886a7f2..ec41f0ddd2 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -796,7 +796,7 @@ freeNamesIdExtras :: IfaceIdExtras -> NameSet freeNamesIdExtras (IdExtras _ rules _) = unionManyNameSets (map freeNamesIfRule rules) instance Outputable IfaceDeclExtras where - ppr IfaceOtherDeclExtras = empty + ppr IfaceOtherDeclExtras = Outputable.empty ppr (IfaceIdExtras extras) = ppr_id_extras extras ppr (IfaceSynExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns] ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns, @@ -1047,7 +1047,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names (is_direct_import, imp_safe) = case lookupModuleEnv direct_imports mod of Just ((_,_,_,safe):_xs) -> (True, safe) - Just _ -> pprPanic "mkUsage: empty direct import" empty + Just _ -> pprPanic "mkUsage: empty direct import" Outputable.empty Nothing -> (False, safeImplicitImpsReq dflags) -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn' -- is used in the source code. We require them to be safe in Safe Haskell diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 50cd824b24..0d6e1ac04c 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -57,7 +57,9 @@ import ErrUtils import qualified Stream import Control.Monad (ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif -- ---------------------------------------------------------------------------- -- * Some Data Types diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs index 5ee7086cbc..7d7bbfe95e 100644 --- a/compiler/main/CmdLineParser.hs +++ b/compiler/main/CmdLineParser.hs @@ -33,8 +33,9 @@ import Data.Function import Data.List import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) - +#endif -------------------------------------------------------- -- The Flag and OptKind types diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 5a18e6e7bf..0e17793e07 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1593,7 +1593,7 @@ mkExtraObjToLinkIntoBinary dflags = do where main - | gopt Opt_NoHsMain dflags = empty + | gopt Opt_NoHsMain dflags = Outputable.empty | otherwise = vcat [ ptext (sLit "#include \"Rts.h\""), ptext (sLit "extern StgClosure ZCMain_main_closure;"), @@ -1603,7 +1603,7 @@ mkExtraObjToLinkIntoBinary dflags = do ptext (sLit " __conf.rts_opts_enabled = ") <> text (show (rtsOptsEnabled dflags)) <> semi, case rtsOpts dflags of - Nothing -> empty + Nothing -> Outputable.empty Just opts -> ptext (sLit " __conf.rts_opts= ") <> text (show opts) <> semi, ptext (sLit " __conf.rts_hs_main = rtsTrue;"), @@ -1639,7 +1639,7 @@ mkNoteObjsToLinkIntoBinary dflags dep_packages = do -- where we need to do this. (if platformHasGnuNonexecStack (targetPlatform dflags) then text ".section .note.GNU-stack,\"\",@progbits\n" - else empty) + else Outputable.empty) ] where diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index c43064e7f1..b06f5bcb9c 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -55,7 +55,11 @@ import qualified Data.Set as Set import Data.IORef import Data.Ord import Data.Time +#if __GLASGOW_HASKELL__ >= 709 +import Control.Monad hiding (empty) +#else import Control.Monad +#endif import Control.Monad.IO.Class import System.IO diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index b5ad08b425..f56c173662 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -609,7 +609,7 @@ cantFindErr cannot_find _ dflags mod_name find_result tried_these files tried_these files - | null files = empty + | null files = Outputable.empty | verbosity dflags < 3 = ptext (sLit "Use -v to see a list of the files searched for.") | otherwise = @@ -628,14 +628,14 @@ cantFindErr cannot_find _ dflags mod_name find_result in ptext (sLit "Perhaps you need to add") <+> quotes (ppr (packageName pkg)) <+> ptext (sLit "to the build-depends in your .cabal file.") - | otherwise = empty + | otherwise = Outputable.empty mod_hidden pkg = ptext (sLit "it is a hidden module in the package") <+> quotes (ppr pkg) pp_suggestions :: [ModuleSuggestion] -> SDoc pp_suggestions sugs - | null sugs = empty + | null sugs = Outputable.empty | otherwise = hang (ptext (sLit "Perhaps you meant")) 2 (vcat (map pp_sugg sugs)) @@ -643,7 +643,7 @@ cantFindErr cannot_find _ dflags mod_name find_result -- package flags when making suggestions. ToDo: if the original package -- also has a reexport, prefer that one pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o - where provenance ModHidden = empty + where provenance ModHidden = Outputable.empty provenance (ModOrigin{ fromOrigPackage = e, fromExposedReexport = res, fromPackageFlag = f }) @@ -657,9 +657,9 @@ cantFindErr cannot_find _ dflags mod_name find_result | f = parens (ptext (sLit "defined via package flags to be") <+> ppr mod) - | otherwise = empty + | otherwise = Outputable.empty pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o - where provenance ModHidden = empty + where provenance ModHidden = Outputable.empty provenance (ModOrigin{ fromOrigPackage = e, fromHiddenReexport = rhs }) | Just False <- e @@ -668,5 +668,5 @@ cantFindErr cannot_find _ dflags mod_name find_result | (pkg:_) <- rhs = parens (ptext (sLit "needs flag -package-key") <+> ppr (packageConfigId pkg)) - | otherwise = empty + | otherwise = Outputable.empty \end{code} diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index fcf235bd23..c6d72b2cc9 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -300,7 +300,7 @@ unsupportedExtnError dflags loc unsup = throw $ mkSrcErr $ unitBag $ mkPlainErrMsg dflags loc $ text "Unsupported extension: " <> text unsup $$ - if null suggestions then empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) + if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions) where suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 01c75c02d8..c14c8cf7f8 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -589,7 +589,7 @@ packageFlagErr dflags (ExposePackage (PackageArg pkg) _) [] packageFlagErr dflags flag reasons = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err)) where err = text "cannot satisfy " <> pprFlag flag <> - (if null reasons then empty else text ": ") $$ + (if null reasons then Outputable.empty else text ": ") $$ nest 4 (ppr_reasons $$ -- ToDo: this admonition seems a bit dodgy text "(use -v for more information)") @@ -608,7 +608,7 @@ pprFlag flag = case flag of PackageArg p -> text "-package " <> text p PackageIdArg p -> text "-package-id " <> text p PackageKeyArg p -> text "-package-key " <> text p - ppr_rns Nothing = empty + ppr_rns Nothing = Outputable.empty ppr_rns (Just rns) = char '(' <> hsep (punctuate comma (map ppr_rn rns)) <> char ')' ppr_rn (orig, new) | orig == new = text orig @@ -1374,7 +1374,7 @@ missingPackageMsg :: Outputable pkgid => pkgid -> SDoc missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p missingDependencyMsg :: Maybe PackageKey -> SDoc -missingDependencyMsg Nothing = empty +missingDependencyMsg Nothing = Outputable.empty missingDependencyMsg (Just parent) = space <> parens (ptext (sLit "dependency of") <+> ftext (packageKeyFS parent)) diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 3c4a551df3..94d64b1073 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -81,7 +81,9 @@ import qualified Stream import Data.List import Data.Maybe import Control.Exception +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Control.Monad import System.IO @@ -594,7 +596,7 @@ makeImportsDoc dflags imports -- There's a hack to make this work in PprMach.pprNatCmmDecl. (if platformHasSubsectionsViaSymbols platform then text ".subsections_via_symbols" - else empty) + else Outputable.empty) $$ -- On recent GNU ELF systems one can mark an object file -- as not requiring an executable stack. If all objects @@ -604,14 +606,14 @@ makeImportsDoc dflags imports -- stack so add the note in: (if platformHasGnuNonexecStack platform then text ".section .note.GNU-stack,\"\",@progbits" - else empty) + else Outputable.empty) $$ -- And just because every other compiler does, let's stick in -- an identifier directive: .ident "GHC x.y.z" (if platformHasIdentDirective platform then let compilerIdent = text "GHC" <+> text cProjectVersion in text ".ident" <+> doubleQuotes compilerIdent - else empty) + else Outputable.empty) where platform = targetPlatform dflags @@ -635,7 +637,7 @@ makeImportsDoc dflags imports map doPpr $ imps | otherwise - = empty + = Outputable.empty doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle) astyle = mkCodeStyle AsmStyle diff --git a/compiler/nativeGen/NCGMonad.hs b/compiler/nativeGen/NCGMonad.hs index a4c9f74df7..f47a1ab434 100644 --- a/compiler/nativeGen/NCGMonad.hs +++ b/compiler/nativeGen/NCGMonad.hs @@ -44,7 +44,9 @@ import DynFlags import Module import Control.Monad ( liftM, ap ) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative ( Applicative(..) ) +#endif data NatM_State = NatM_State { diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs index 39b5777ef3..287bdc65e4 100644 --- a/compiler/nativeGen/RegAlloc/Linear/State.hs +++ b/compiler/nativeGen/RegAlloc/Linear/State.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE CPP #-} -- | State monad for the linear register allocator. @@ -43,8 +44,9 @@ import Unique import UniqSupply import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) - +#endif -- | The register allocator monad type. newtype RegM freeRegs a diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index cfe795585b..8fd5bd93db 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -88,6 +88,7 @@ import Ctype import BasicTypes ( InlineSpec(..), RuleMatchInfo(..), FractionalLit(..) ) import Util ( readRational ) +import Control.Applicative import Control.Monad import Data.Bits import Data.ByteString (ByteString) @@ -1680,6 +1681,13 @@ data ALRLayout = ALRLayoutLet newtype P a = P { unP :: PState -> ParseResult a } +instance Functor P where + fmap = liftM + +instance Applicative P where + pure = return + (<*>) = ap + instance Monad P where return = returnP (>>=) = thenP diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index 6cac513b13..b13251c1e6 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -87,7 +87,12 @@ import Maybes import Util import Control.Applicative ((<$>)) +#if __GLASGOW_HASKELL__ >= 709 +import Control.Monad hiding (empty, many) +#else import Control.Monad +#endif + import Text.ParserCombinators.ReadP as ReadP import Data.Char diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index ed6fa3f791..a182e9b0fb 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -735,8 +735,8 @@ ap_RDR = nameRdrName apAName foldable_foldr_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldr") foldMap_RDR = varQual_RDR dATA_FOLDABLE (fsLit "foldMap") traverse_RDR = varQual_RDR dATA_TRAVERSABLE (fsLit "traverse") -mempty_RDR = varQual_RDR dATA_MONOID (fsLit "mempty") -mappend_RDR = varQual_RDR dATA_MONOID (fsLit "mappend") +mempty_RDR = varQual_RDR gHC_BASE (fsLit "mempty") +mappend_RDR = varQual_RDR gHC_BASE (fsLit "mappend") ---------------------- varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR @@ -849,7 +849,7 @@ failMName = varQual gHC_BASE (fsLit "fail") failMClassOpKey -- Classes (Applicative, Foldable, Traversable) applicativeClassName, foldableClassName, traversableClassName :: Name -applicativeClassName = clsQual cONTROL_APPLICATIVE (fsLit "Applicative") applicativeClassKey +applicativeClassName = clsQual gHC_BASE (fsLit "Applicative") applicativeClassKey foldableClassName = clsQual dATA_FOLDABLE (fsLit "Foldable") foldableClassKey traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") traversableClassKey @@ -858,10 +858,10 @@ traversableClassName = clsQual dATA_TRAVERSABLE (fsLit "Traversable") trave -- AMP additions joinMName, apAName, pureAName, alternativeClassName :: Name -joinMName = varQual mONAD (fsLit "join") joinMIdKey -apAName = varQual cONTROL_APPLICATIVE (fsLit "<*>") apAClassOpKey -pureAName = varQual cONTROL_APPLICATIVE (fsLit "pure") pureAClassOpKey -alternativeClassName = clsQual cONTROL_APPLICATIVE (fsLit "Alternative") alternativeClassKey +joinMName = varQual gHC_BASE (fsLit "join") joinMIdKey +apAName = varQual gHC_BASE (fsLit "<*>") apAClassOpKey +pureAName = varQual gHC_BASE (fsLit "pure") pureAClassOpKey +alternativeClassName = clsQual mONAD (fsLit "Alternative") alternativeClassKey joinMIdKey, apAClassOpKey, pureAClassOpKey, alternativeClassKey :: Unique joinMIdKey = mkPreludeMiscIdUnique 750 diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index d2e648f382..a91d3f7d9e 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -48,7 +48,10 @@ import Platform import Util import Coercion (mkUnbranchedAxInstCo,mkSymCo,Role(..)) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative ( Applicative(..), Alternative(..) ) +#endif + import Control.Monad import Data.Bits as Bits import qualified Data.ByteString as BS diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index 4a6da2417e..f9dc4a359f 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -39,8 +39,9 @@ import SrcLoc import Util import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) - +#endif stgMassageForProfiling :: DynFlags diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index f333a239a1..b9bfcce531 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -796,7 +796,7 @@ warnIfDeprecated gre@(GRE { gre_name = name, gre_prov = Imported (imp_spec : _) name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name imp_mod = importSpecModule imp_spec imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra - extra | imp_mod == moduleName name_mod = empty + extra | imp_mod == moduleName name_mod = Outputable.empty | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod doc = ptext (sLit "The name") <+> quotes (ppr name) <+> ptext (sLit "is mentioned explicitly") @@ -985,7 +985,7 @@ lookupBindGroupOcc ctxt what rdr_name = do { env <- getGlobalRdrEnv ; let all_gres = lookupGlobalRdrEnv env (rdrNameOcc rdr_name) ; case filter (keep_me . gre_name) all_gres of - [] | null all_gres -> bale_out_with empty + [] | null all_gres -> bale_out_with Outputable.empty | otherwise -> bale_out_with local_msg (gre:_) | ParentIs {} <- gre_par gre @@ -1000,7 +1000,7 @@ lookupBindGroupOcc ctxt what rdr_name Just n | n `elemNameSet` bound_names -> return (Right n) | otherwise -> bale_out_with local_msg - Nothing -> bale_out_with empty } + Nothing -> bale_out_with Outputable.empty } bale_out_with msg = return (Left (sep [ ptext (sLit "The") <+> what @@ -1416,7 +1416,7 @@ reportUnboundName :: RdrName -> RnM Name reportUnboundName rdr = unboundName WL_Any rdr unboundName :: WhereLooking -> RdrName -> RnM Name -unboundName wl rdr = unboundNameX wl rdr empty +unboundName wl rdr = unboundNameX wl rdr Outputable.empty unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name unboundNameX where_look rdr_name extra @@ -1436,7 +1436,7 @@ unknownNameErr what rdr_name , extra ] where extra | rdr_name == forall_tv_RDR = perhapsForallMsg - | otherwise = empty + | otherwise = Outputable.empty type HowInScope = Either SrcSpan ImpDeclSpec -- Left loc => locally bound at loc @@ -1457,7 +1457,7 @@ unknownNameSuggestErr where_look tried_rdr_name suggest = fuzzyLookup (showPpr dflags tried_rdr_name) all_possibilities perhaps = ptext (sLit "Perhaps you meant") extra_err = case suggest of - [] -> empty + [] -> Outputable.empty [p] -> perhaps <+> pp_item p ps -> sep [ perhaps <+> ptext (sLit "one of these:") , nest 2 (pprWithCommas pp_item ps) ] @@ -1473,7 +1473,7 @@ unknownNameSuggestErr where_look tried_rdr_name pp_ns :: RdrName -> SDoc pp_ns rdr | ns /= tried_ns = pprNameSpace ns - | otherwise = empty + | otherwise = Outputable.empty where ns = rdrNameSpace rdr tried_occ = rdrNameOcc tried_rdr_name diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 2872b480c2..79a944fb2f 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -1247,7 +1247,7 @@ pprStmtCat (ParStmt {}) = ptext (sLit "parallel") ------------ emptyInvalid :: Validity -- Payload is the empty document -emptyInvalid = NotValid empty +emptyInvalid = NotValid Outputable.empty okStmt, okDoStmt, okCompStmt, okParStmt, okPArrStmt :: DynFlags -> HsStmtContext Name diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 5071828e4d..cd43d8a866 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -1447,13 +1447,13 @@ warnUnusedImport (L loc decl, used, unused) nest 2 (ptext (sLit "except perhaps to import instances from") <+> quotes pp_mod), ptext (sLit "To import instances alone, use:") - <+> ptext (sLit "import") <+> pp_mod <> parens empty ] + <+> ptext (sLit "import") <+> pp_mod <> parens Outputable.empty ] msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused), text "from module" <+> quotes pp_mod <+> pp_not_used] pp_herald = text "The" <+> pp_qual <+> text "import of" pp_qual | ideclQualified decl = text "qualified" - | otherwise = empty + | otherwise = Outputable.empty pp_mod = ppr (unLoc (ideclName decl)) pp_not_used = text "is redundant" \end{code} @@ -1574,7 +1574,7 @@ badImportItemErrStd iface decl_spec ie ptext (sLit "does not export"), quotes (ppr ie)] where source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") - | otherwise = empty + | otherwise = Outputable.empty badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc badImportItemErrDataCon dataType iface decl_spec ie @@ -1597,7 +1597,7 @@ badImportItemErrDataCon dataType iface decl_spec ie datacon_occ = rdrNameOcc $ ieName ie datacon = parenSymOcc datacon_occ (ppr datacon_occ) source_import | mi_boot iface = ptext (sLit "(hi-boot interface)") - | otherwise = empty + | otherwise = Outputable.empty parens_sp d = parens (space <> d <> space) -- T( f,g ) badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index ad4a0e1a1b..dcedfb4523 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -376,7 +376,7 @@ instance Outputable CoreToDo where pprPassDetails :: CoreToDo -> SDoc pprPassDetails (CoreDoSimplify n md) = vcat [ ptext (sLit "Max iterations =") <+> int n , ppr md ] -pprPassDetails _ = empty +pprPassDetails _ = Outputable.empty \end{code} \begin{code} @@ -633,7 +633,7 @@ pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 }) vcat [blankLine, ptext (sLit "Log (most recent first)"), nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))] - else empty + else Outputable.empty ] pprTickCounts :: Map Tick Int -> SDoc @@ -734,7 +734,7 @@ pprTickCts (PreInlineUnconditionally v) = ppr v pprTickCts (PostInlineUnconditionally v)= ppr v pprTickCts (UnfoldingDone v) = ppr v pprTickCts (RuleFired v) = ppr v -pprTickCts LetFloatFromLet = empty +pprTickCts LetFloatFromLet = Outputable.empty pprTickCts (EtaExpansion v) = ppr v pprTickCts (EtaReduction v) = ppr v pprTickCts (BetaReduction v) = ppr v @@ -745,7 +745,7 @@ pprTickCts (AltMerge v) = ppr v pprTickCts (CaseElim v) = ppr v pprTickCts (CaseIdentity v) = ppr v pprTickCts (FillInCaseDefault v) = ppr v -pprTickCts _ = empty +pprTickCts _ = Outputable.empty cmpTick :: Tick -> Tick -> Ordering cmpTick a b = case (tickToTag a `compare` tickToTag b) of diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index cbce63f2cf..09acd70e74 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -37,7 +37,9 @@ import Outputable import FastString import State +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif import Control.Monad import Data.Map (Map) import qualified Data.Map as Map diff --git a/compiler/stgSyn/StgLint.lhs b/compiler/stgSyn/StgLint.lhs index ec9f6fa9d6..93fc9cd71e 100644 --- a/compiler/stgSyn/StgLint.lhs +++ b/compiler/stgSyn/StgLint.lhs @@ -27,7 +27,9 @@ import Util import SrcLoc import Outputable import FastString +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative ( Applicative(..) ) +#endif import Control.Monad import Data.Function @@ -486,7 +488,7 @@ checkTys ty1 ty2 msg = LintM $ \loc _scope errs _mkCaseAltMsg :: [StgAlt] -> MsgDoc _mkCaseAltMsg _alts = ($$) (text "In some case alternatives, type of alternatives not all same:") - (empty) -- LATER: ppr alts + (Outputable.empty) -- LATER: ppr alts mkDefltMsg :: Id -> TyCon -> MsgDoc mkDefltMsg bndr tc diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 6feab9e728..c286d3bcc1 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -488,7 +488,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list recoverM (recoveryCode binder_names sig_fn) $ do -- Set up main recover; take advantage of any type sigs - { traceTc "------------------------------------------------" empty + { traceTc "------------------------------------------------" Outputable.empty ; traceTc "Bindings for {" (ppr binder_names) ; dflags <- getDynFlags ; type_env <- getLclTypeEnv diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 6812ac7387..a14d29eee5 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -2176,7 +2176,7 @@ derivingThingErr newtype_deriving clas tys ty why nest 2 why] where extra | newtype_deriving = ptext (sLit "(even with cunning newtype deriving)") - | otherwise = empty + | otherwise = Outputable.empty pred = mkClassPred clas (tys ++ [ty]) derivingHiddenErr :: TyCon -> SDoc diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index 7e6c495506..6188842b72 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -1496,15 +1496,15 @@ funResCtxt has_args fun fun_res_ty env_ty tidy_env (args_env, res_env) = tcSplitFunTys env' n_fun = length args_fun n_env = length args_env - info | n_fun == n_env = empty + info | n_fun == n_env = Outputable.empty | n_fun > n_env , not_fun res_env = ptext (sLit "Probable cause:") <+> quotes (ppr fun) <+> ptext (sLit "is applied to too few arguments") | has_args , not_fun res_fun = ptext (sLit "Possible cause:") <+> quotes (ppr fun) <+> ptext (sLit "is applied to too many arguments") - | otherwise = empty -- Never suggest that a naked variable is - -- applied to too many args! + | otherwise = Outputable.empty -- Never suggest that a naked variable is + -- applied to too many args! ; return (tidy_env, info) } where not_fun ty -- ty is definitely not an arrow type, @@ -1608,8 +1608,8 @@ missingStrictFields :: DataCon -> [FieldLabel] -> SDoc missingStrictFields con fields = header <> rest where - rest | null fields = empty -- Happens for non-record constructors - -- with strict fields + rest | null fields = Outputable.empty -- Happens for non-record constructors + -- with strict fields | otherwise = colon <+> pprWithCommas ppr fields header = ptext (sLit "Constructor") <+> quotes (ppr con) <+> diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index 303391fcdd..9d1da3fc48 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -268,7 +268,7 @@ tcCheckFIType arg_tys res_ty (CImport cconv safety mh l@(CLabel _)) = do checkCg checkCOrAsmOrLlvmOrInterp -- NB check res_ty not sig_ty! -- In case sig_ty is (forall a. ForeignPtr a) - check (isFFILabelTy (mkFunTys arg_tys res_ty)) (illegalForeignTyErr empty) + check (isFFILabelTy (mkFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty) cconv' <- checkCConv cconv return (CImport cconv' safety mh l) @@ -285,7 +285,7 @@ tcCheckFIType arg_tys res_ty (CImport cconv safety mh CWrapper) = do checkForeignRes mustBeIO checkSafe (isFFIDynTy arg1_ty) res_ty where (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty - _ -> addErrTc (illegalForeignTyErr empty (ptext (sLit "One argument expected"))) + _ -> addErrTc (illegalForeignTyErr Outputable.empty (ptext (sLit "One argument expected"))) return (CImport cconv' safety mh CWrapper) tcCheckFIType arg_tys res_ty idecl@(CImport cconv safety mh (CFunction target)) @@ -294,7 +294,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport cconv safety mh (CFunction target)) cconv' <- checkCConv cconv case arg_tys of -- The first arg must be Ptr or FunPtr [] -> - addErrTc (illegalForeignTyErr empty (ptext (sLit "At least one argument expected"))) + addErrTc (illegalForeignTyErr Outputable.empty (ptext (sLit "At least one argument expected"))) (arg1_ty:arg_tys) -> do dflags <- getDynFlags let curried_res_ty = foldr FunTy res_ty arg_tys diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index 2b123ffab6..f559dda17f 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -400,7 +400,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls -- try the deriving stuff, because that may give -- more errors still - ; traceTc "tcDeriving" empty + ; traceTc "tcDeriving" Outputable.empty ; th_stage <- getStage -- See Note [Deriving inside TH brackets ] ; (gbl_env, deriv_inst_info, deriv_binds) <- if isBrackStage th_stage diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index cfc76d6538..c052575c12 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -826,7 +826,7 @@ tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside ; req_wrap <- instCall PatOrigin inst_tys req_theta' ; traceTc "instCall" (ppr req_wrap) - ; traceTc "checkConstraints {" empty + ; traceTc "checkConstraints {" Outputable.empty ; (ev_binds, (arg_pats', res)) <- checkConstraints skol_info ex_tvs' prov_dicts' $ tcConArgs (PatSynCon pat_syn) arg_tys' arg_pats penv thing_inside diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 9898b46066..49276848ff 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -100,7 +100,11 @@ import Maybes import Util import Bag +#if __GLASGOW_HASKELL__ >= 709 +import Control.Monad hiding (empty) +#else import Control.Monad +#endif #include "HsVersions.h" \end{code} diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 9dbc4206a5..c3215b3f6f 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -968,10 +968,10 @@ addWarnTcM (env0, msg) add_warn msg err_info } addWarn :: MsgDoc -> TcRn () -addWarn msg = add_warn msg empty +addWarn msg = add_warn msg Outputable.empty addWarnAt :: SrcSpan -> MsgDoc -> TcRn () -addWarnAt loc msg = add_warn_at loc msg empty +addWarnAt loc msg = add_warn_at loc msg Outputable.empty add_warn :: MsgDoc -> MsgDoc -> TcRn () add_warn msg extra_info @@ -1012,7 +1012,7 @@ mkErrInfo env ctxts = go 0 env ctxts where go :: Int -> TidyEnv -> [ErrCtxt] -> TcM SDoc - go _ _ [] = return empty + go _ _ [] = return Outputable.empty go n env ((is_landmark, ctxt) : ctxts) | is_landmark || n < mAX_CONTEXTS -- Too verbose || opt_PprStyle_Debug = do { (env', msg) <- ctxt env diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 3c6aedb429..a4a7b293d9 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -2252,7 +2252,7 @@ addTyThingCtxt thing | isDataTyCon tc -> ptext (sLit "data") _ -> pprTrace "addTyThingCtxt strange" (ppr thing) - empty + Outputable.empty ctxt = hsep [ ptext (sLit "In the"), flav , ptext (sLit "declaration for"), quotes (ppr name) ] diff --git a/compiler/typecheck/TcTyDecls.lhs b/compiler/typecheck/TcTyDecls.lhs index 262aa519b3..2360f7b726 100644 --- a/compiler/typecheck/TcTyDecls.lhs +++ b/compiler/typecheck/TcTyDecls.lhs @@ -49,7 +49,11 @@ import UniqSet import Util import Maybes import Data.List + +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif + import Control.Monad \end{code} diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs index db3ae8315f..6c14b4b7bc 100644 --- a/compiler/typecheck/TcType.lhs +++ b/compiler/typecheck/TcType.lhs @@ -177,7 +177,9 @@ import ErrUtils( Validity(..), isValid ) import Data.IORef import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif \end{code} %************************************************************************ diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index ef06ddd263..f943ccd663 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -388,7 +388,7 @@ tcGen :: UserTypeCtxt -> TcType tcGen ctxt expected_ty thing_inside -- We expect expected_ty to be a forall-type -- If not, the call is a no-op - = do { traceTc "tcGen" empty + = do { traceTc "tcGen" Outputable.empty ; (wrap, tvs', given, rho') <- deeplySkolemise expected_ty ; when debugIsOn $ @@ -565,7 +565,7 @@ uType origin orig_ty1 orig_ty2 , ppr origin] ; co <- go orig_ty1 orig_ty2 ; if isTcReflCo co - then traceTc "u_tys yields no coercion" empty + then traceTc "u_tys yields no coercion" Outputable.empty else traceTc "u_tys yields coercion:" (ppr co) ; return co } where diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index ad81623c67..8381533a28 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -404,7 +404,7 @@ forAllTyErr rank ty suggestion = case rank of LimitedRank {} -> ptext (sLit "Perhaps you intended to use RankNTypes or Rank2Types") MonoType d -> d - _ -> empty -- Polytype is always illegal + _ -> Outputable.empty -- Polytype is always illegal unliftedArgErr, ubxArgTyErr :: Type -> SDoc unliftedArgErr ty = sep [ptext (sLit "Illegal unlifted type:"), ppr ty] diff --git a/compiler/types/Unify.lhs b/compiler/types/Unify.lhs index 1eb1c2b872..709c0e5ecc 100644 --- a/compiler/types/Unify.lhs +++ b/compiler/types/Unify.lhs @@ -41,7 +41,9 @@ import TypeRep import Util import Control.Monad (liftM, ap) +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) +#endif \end{code} diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index 1db15537c7..8193beb87f 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, UndecidableInstances #-} +{-# LANGUAGE CPP #-} -- -- (c) The University of Glasgow 2002-2006 @@ -43,7 +44,9 @@ import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO ( fixIO ) import Control.Monad import MonadUtils +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Alternative(..)) +#endif ---------------------------------------------------------------------- -- Defining the monad type diff --git a/compiler/utils/Maybes.lhs b/compiler/utils/Maybes.lhs index d9e1762a2f..8052b1d848 100644 --- a/compiler/utils/Maybes.lhs +++ b/compiler/utils/Maybes.lhs @@ -4,6 +4,7 @@ % \begin{code} +{-# LANGUAGE CPP #-} module Maybes ( module Data.Maybe, @@ -17,7 +18,9 @@ module Maybes ( MaybeT(..) ) where +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative +#endif import Control.Monad import Data.Maybe diff --git a/compiler/utils/Stream.hs b/compiler/utils/Stream.hs index 47cdee0789..edb0b0c558 100644 --- a/compiler/utils/Stream.hs +++ b/compiler/utils/Stream.hs @@ -5,14 +5,17 @@ -- Monadic streams -- -- ----------------------------------------------------------------------------- - +{-# LANGUAGE CPP #-} module Stream ( Stream(..), yield, liftIO, collect, fromList, Stream.map, Stream.mapM, Stream.mapAccumL ) where import Control.Monad +#if __GLASGOW_HASKELL__ < 709 import Control.Applicative +#endif + -- | -- @Stream m a b@ is a computation in some Monad @m@ that delivers a sequence diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs index 6adb9ec435..f9759039dc 100644 --- a/compiler/vectorise/Vectorise/Exp.hs +++ b/compiler/vectorise/Vectorise/Exp.hs @@ -415,11 +415,11 @@ vectExpr (_, AnnCase scrut bndr ty alts) vectExpr (_, AnnLet (AnnNonRec bndr rhs) body) = do - { traceVt "let binding (non-recursive)" empty + { traceVt "let binding (non-recursive)" Outputable.empty ; vrhs <- localV $ inBind bndr $ vectAnnPolyExpr False rhs - ; traceVt "let body (non-recursive)" empty + ; traceVt "let body (non-recursive)" Outputable.empty ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body) ; return $ vLet (vNonRec vbndr vrhs) vbody } @@ -427,9 +427,9 @@ vectExpr (_, AnnLet (AnnNonRec bndr rhs) body) vectExpr (_, AnnLet (AnnRec bs) body) = do { (vbndrs, (vrhss, vbody)) <- vectBndrsIn bndrs $ do - { traceVt "let bindings (recursive)" empty + { traceVt "let bindings (recursive)" Outputable.empty ; vrhss <- zipWithM vect_rhs bndrs rhss - ; traceVt "let body (recursive)" empty + ; traceVt "let body (recursive)" Outputable.empty ; vbody <- vectExpr body ; return (vrhss, vbody) } @@ -830,28 +830,28 @@ vectAlgCase :: TyCon -> [Type] -> CoreExprWithVectInfo -> Var -> Type -> VM VExpr vectAlgCase _tycon _ty_args scrut bndr ty [(DEFAULT, [], body)] = do - { traceVt "scrutinee (DEFAULT only)" empty + { traceVt "scrutinee (DEFAULT only)" Outputable.empty ; vscrut <- vectExpr scrut ; (vty, lty) <- vectAndLiftType ty - ; traceVt "alternative body (DEFAULT only)" empty + ; traceVt "alternative body (DEFAULT only)" Outputable.empty ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body) ; return $ vCaseDEFAULT vscrut vbndr vty lty vbody } vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt _, [], body)] = do - { traceVt "scrutinee (one shot w/o binders)" empty + { traceVt "scrutinee (one shot w/o binders)" Outputable.empty ; vscrut <- vectExpr scrut ; (vty, lty) <- vectAndLiftType ty - ; traceVt "alternative body (one shot w/o binders)" empty + ; traceVt "alternative body (one shot w/o binders)" Outputable.empty ; (vbndr, vbody) <- vectBndrIn bndr (vectExpr body) ; return $ vCaseDEFAULT vscrut vbndr vty lty vbody } vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)] = do - { traceVt "scrutinee (one shot w/ binders)" empty + { traceVt "scrutinee (one shot w/ binders)" Outputable.empty ; vexpr <- vectExpr scrut ; (vty, lty) <- vectAndLiftType ty - ; traceVt "alternative body (one shot w/ binders)" empty + ; traceVt "alternative body (one shot w/ binders)" Outputable.empty ; (vbndr, (vbndrs, (vect_body, lift_body))) <- vect_scrut_bndr . vectBndrsIn bndrs @@ -876,7 +876,7 @@ vectAlgCase _tycon _ty_args scrut bndr ty [(DataAlt dc, bndrs, body)] vectAlgCase tycon _ty_args scrut bndr ty alts = do - { traceVt "scrutinee (general case)" empty + { traceVt "scrutinee (general case)" Outputable.empty ; vexpr <- vectExpr scrut ; vect_tc <- vectTyCon tycon @@ -887,7 +887,7 @@ vectAlgCase tycon _ty_args scrut bndr ty alts ; sel_bndr <- newLocalVar (fsLit "sel") sel_ty ; let sel = Var sel_bndr - ; traceVt "alternatives' body (general case)" empty + ; traceVt "alternatives' body (general case)" Outputable.empty ; (vbndr, valts) <- vect_scrut_bndr $ mapM (proc_alt arity sel vty lty) alts' ; let (vect_dcs, vect_bndrss, lift_bndrss, vbodies) = unzip4 valts diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index 6ee5ca6cd9..b73d094a65 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -227,7 +227,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls ; traceVt " VECT SCALAR : " $ ppr (scalarTyConsNoRHS ++ map fst scalarTyConsWithRHS) ; traceVt " VECT [class] : " $ ppr impVectTyCons ; traceVt " VECT with rhs : " $ ppr (map fst (vectTyConsWithRHS ++ scalarTyConsWithRHS)) - ; traceVt " -- after classification (local and VECT [class] tycons) --" empty + ; traceVt " -- after classification (local and VECT [class] tycons) --" Outputable.empty ; traceVt " reuse : " $ ppr keep_tcs ; traceVt " convert : " $ ppr conv_tcs |