Commit d94de872 authored by Austin Seipp's avatar Austin Seipp

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: default avatarAustin 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
parent fdfe6c0e
......@@ -897,8 +897,8 @@ changequote([, ])dnl
])
if test ! -f compiler/parser/Parser.hs || test ! -f compiler/cmm/CmmParse.hs
then
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19],
[AC_MSG_ERROR([Happy version 1.19 or later is required to compile GHC.])])[]
FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.4],
[AC_MSG_ERROR([Happy version 1.19.4 or later is required to compile GHC.])])[]
fi
HappyVersion=$fptools_cv_happy_version;
AC_SUBST(HappyVersion)
......
......@@ -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]
......
......@@ -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)
......
......@@ -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
......
......@@ -53,6 +53,10 @@ import DynFlags
import Data.Maybe
import Control.Monad
#if __GLASGOW_HASKELL__ >= 709
import Prelude hiding ((<*>))
#endif
------------------------------------------------------------------------
-- Top-level bindings
------------------------------------------------------------------------
......
......@@ -48,6 +48,10 @@ import Outputable
import Control.Monad (when,void)
#if __GLASGOW_HASKELL__ >= 709
import Prelude hiding ((<*>))
#endif
------------------------------------------------------------------------
-- cgExpr: the main function
------------------------------------------------------------------------
......
{-# 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
......
......@@ -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
......
......@@ -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)
......
......@@ -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 )
......
......@@ -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
......
......@@ -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)
......
......@@ -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
--------------
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
%************************************************************************
......
......@@ -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}
......@@ -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}
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......@@ -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
......
......@@ -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