summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Terei <davidterei@gmail.com>2011-11-16 13:37:34 -0800
committerDavid Terei <davidterei@gmail.com>2011-11-16 13:37:34 -0800
commit4a5efba4c458927914e51a974e72816b6fc1a4c1 (patch)
treea9806ac912341cbaff09e7117ddb06aee47b0612
parent14bbddac31aa900733ebd03d7c38caeecb619219 (diff)
downloadhaskell-4a5efba4c458927914e51a974e72816b6fc1a4c1.tar.gz
Tabs -> Spaces + formatting fixes
Diffstat
-rw-r--r--compiler/basicTypes/Module.lhs131
-rw-r--r--compiler/main/DynFlags.hs6
-rw-r--r--compiler/main/ErrUtils.lhs134
-rw-r--r--compiler/main/ErrUtils.lhs-boot1
-rw-r--r--compiler/main/HscMain.hs66
-rw-r--r--compiler/main/HscTypes.lhs203
-rw-r--r--compiler/utils/Bag.lhs7
-rw-r--r--compiler/utils/Outputable.lhs322
8 files changed, 427 insertions, 443 deletions
diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 06fd6a5c73..b5fe77d4db 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -9,14 +9,8 @@ These are Uniquable, hence we can build Maps with Modules as
the keys.
\begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-module Module
+
+module Module
(
-- * The ModuleName type
ModuleName,
@@ -34,47 +28,47 @@ module Module
packageIdFS,
stringToPackageId,
packageIdString,
- stablePackageIdCmp,
-
- -- * Wired-in PackageIds
- -- $wired_in_packages
- primPackageId,
- integerPackageId,
- basePackageId,
- rtsPackageId,
- thPackageId,
+ stablePackageIdCmp,
+
+ -- * Wired-in PackageIds
+ -- $wired_in_packages
+ primPackageId,
+ integerPackageId,
+ basePackageId,
+ rtsPackageId,
+ thPackageId,
dphSeqPackageId,
dphParPackageId,
- mainPackageId,
+ mainPackageId,
thisGhcPackageId,
-
- -- * The Module type
- Module,
- modulePackageId, moduleName,
- pprModule,
- mkModule,
+
+ -- * The Module type
+ Module,
+ modulePackageId, moduleName,
+ pprModule,
+ mkModule,
stableModuleCmp,
- -- * The ModuleLocation type
- ModLocation(..),
- addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
-
- -- * Module mappings
- ModuleEnv,
- elemModuleEnv, extendModuleEnv, extendModuleEnvList,
- extendModuleEnvList_C, plusModuleEnv_C,
- delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
- lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
- moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+ -- * The ModuleLocation type
+ ModLocation(..),
+ addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
+
+ -- * Module mappings
+ ModuleEnv,
+ elemModuleEnv, extendModuleEnv, extendModuleEnvList,
+ extendModuleEnvList_C, plusModuleEnv_C,
+ delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
+ lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
+ moduleEnvKeys, moduleEnvElts, moduleEnvToList,
unitModuleEnv, isEmptyModuleEnv,
foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
- -- * ModuleName mappings
- ModuleNameEnv,
+ -- * ModuleName mappings
+ ModuleNameEnv,
- -- * Sets of Modules
- ModuleSet,
- emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
+ -- * Sets of Modules
+ ModuleSet,
+ emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
) where
#include "Typeable.h"
@@ -95,9 +89,9 @@ import System.FilePath
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Module locations}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -106,19 +100,19 @@ import System.FilePath
data ModLocation
= ModLocation {
ml_hs_file :: Maybe FilePath,
- -- The source file, if we have one. Package modules
- -- probably don't have source files.
+ -- The source file, if we have one. Package modules
+ -- probably don't have source files.
ml_hi_file :: FilePath,
- -- Where the .hi file is, whether or not it exists
- -- yet. Always of form foo.hi, even if there is an
- -- hi-boot file (we add the -boot suffix later)
+ -- Where the .hi file is, whether or not it exists
+ -- yet. Always of form foo.hi, even if there is an
+ -- hi-boot file (we add the -boot suffix later)
ml_obj_file :: FilePath
- -- Where the .o file is, whether or not it exists yet.
- -- (might not exist either because the module hasn't
- -- been compiled yet, or because it is part of a
- -- package with a .a file)
+ -- Where the .o file is, whether or not it exists yet.
+ -- (might not exist either because the module hasn't
+ -- been compiled yet, or because it is part of a
+ -- package with a .a file)
} deriving Show
instance Outputable ModLocation where
@@ -126,7 +120,7 @@ instance Outputable ModLocation where
\end{code}
For a module in another package, the hs_file and obj_file
-components of ModLocation are undefined.
+components of ModLocation are undefined.
The locations specified by a ModLocation may or may not
correspond to actual files yet: for example, even if the object
@@ -148,15 +142,15 @@ addBootSuffixLocn :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all file paths associated with the module
addBootSuffixLocn locn
= locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
- , ml_hi_file = addBootSuffix (ml_hi_file locn)
- , ml_obj_file = addBootSuffix (ml_obj_file locn) }
+ , ml_hi_file = addBootSuffix (ml_hi_file locn)
+ , ml_obj_file = addBootSuffix (ml_obj_file locn) }
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{The name of a module}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -194,11 +188,11 @@ stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
pprModuleName :: ModuleName -> SDoc
-pprModuleName (ModuleName nm) =
+pprModuleName (ModuleName nm) =
getPprStyle $ \ sty ->
- if codeStyle sty
- then ftext (zEncodeFS nm)
- else ftext nm
+ if codeStyle sty
+ then ftext (zEncodeFS nm)
+ else ftext nm
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod
@@ -226,9 +220,9 @@ moduleNameColons = dots_to_colons . moduleNameString
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{A fully qualified module}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -259,7 +253,7 @@ instance Data Module where
-- gives an ordering based on the 'Unique's of the components, which may
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
-stableModuleCmp (Module p1 n1) (Module p2 n2)
+stableModuleCmp (Module p1 n1) (Module p2 n2)
= (p1 `stablePackageIdCmp` p2) `thenCmp`
(n1 `stableModuleNameCmp` n2)
@@ -274,8 +268,8 @@ pprPackagePrefix :: PackageId -> Module -> SDoc
pprPackagePrefix p mod = getPprStyle doc
where
doc sty
- | codeStyle sty =
- if p == mainPackageId
+ | codeStyle sty =
+ if p == mainPackageId
then empty -- never qualify the main package in code
else ftext (zEncodeFS (packageIdFS p)) <> char '_'
| qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
@@ -336,7 +330,7 @@ packageIdString = unpackFS . packageIdFS
-- -----------------------------------------------------------------------------
-- $wired_in_packages
-- Certain packages are known to the compiler, in that we know about certain
--- entities that reside in these packages, and the compiler needs to
+-- entities that reside in these packages, and the compiler needs to
-- declare static Modules and Names that refer to these packages. Hence
-- the wired-in packages can't include version numbers, since we don't want
-- to bake the version numbers of these packages into GHC.
@@ -370,7 +364,7 @@ thisGhcPackageId = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
-- | This is the package Id for the current program. It is the default
-- package Id if you don't specify a package name. We don't add this prefix
-- to symbol names, since there can be only one main package per program.
-mainPackageId = fsToPackageId (fsLit "main")
+mainPackageId = fsToPackageId (fsLit "main")
\end{code}
%************************************************************************
@@ -452,7 +446,7 @@ foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
-- | A set of 'Module's
type ModuleSet = Map Module ()
-mkModuleSet :: [Module] -> ModuleSet
+mkModuleSet :: [Module] -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
emptyModuleSet :: ModuleSet
moduleSetElts :: ModuleSet -> [Module]
@@ -472,3 +466,4 @@ UniqFM.
-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
type ModuleNameEnv elt = UniqFM elt
\end{code}
+
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 3066dde02f..2c71f33909 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -397,7 +397,7 @@ data ExtensionFlag
| Opt_RebindableSyntax
| Opt_ConstraintKinds
| Opt_PolyKinds -- Kind polymorphism
-
+
| Opt_StandaloneDeriving
| Opt_DeriveDataTypeable
| Opt_DeriveFunctor
@@ -1293,7 +1293,7 @@ parseDynamicFlags dflags0 args cmdline = do
-- check for disabled flags in safe haskell
let (dflags2, sh_warns) = safeFlagCheck dflags1
-
+
return (dflags2, leftover, sh_warns ++ warns)
-- | Check (and potentially disable) any extensions that aren't allowed
@@ -1919,7 +1919,7 @@ xFlags = [
( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "ConstraintKinds", Opt_ConstraintKinds, nop ),
( "PolyKinds", Opt_PolyKinds, nop ),
- ( "MonoPatBinds", Opt_MonoPatBinds,
+ ( "MonoPatBinds", Opt_MonoPatBinds,
\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
( "ExplicitForAll", Opt_ExplicitForAll, nop ),
( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, nop ),
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index af5294a633..96bd5003de 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -4,49 +4,43 @@
\section[ErrsUtils]{Utilities for error reporting}
\begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
module ErrUtils (
- Message, mkLocMessage, printError, pprMessageBag, pprErrMsgBag,
- Severity(..),
+ Message, mkLocMessage, printError, pprMessageBag, pprErrMsgBag,
+ Severity(..),
- ErrMsg, WarnMsg,
+ ErrMsg, WarnMsg,
ErrorMessages, WarningMessages,
errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
- Messages, errorsFound, emptyMessages,
- mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
- printBagOfErrors, printBagOfWarnings,
- warnIsErrorMsg, mkLongWarnMsg,
-
- ghcExit,
- doIfSet, doIfSet_dyn,
- dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_or,
+ Messages, errorsFound, emptyMessages,
+ mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
+ printBagOfErrors, printBagOfWarnings,
+ warnIsErrorMsg, mkLongWarnMsg,
+
+ ghcExit,
+ doIfSet, doIfSet_dyn,
+ dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_or,
mkDumpDoc, dumpSDoc,
- -- * Messages during compilation
+ -- * Messages during compilation
putMsg, putMsgWith,
- errorMsg,
- fatalErrorMsg, fatalErrorMsg',
- compilationProgressMsg,
- showPass,
- debugTraceMsg,
+ errorMsg,
+ fatalErrorMsg, fatalErrorMsg',
+ compilationProgressMsg,
+ showPass,
+ debugTraceMsg,
) where
#include "HsVersions.h"
-import Bag ( Bag, bagToList, isEmptyBag, emptyBag )
-import Util ( sortLe )
+import Bag ( Bag, bagToList, isEmptyBag, emptyBag )
+import Util ( sortLe )
import Outputable
import SrcLoc
import DynFlags
-import StaticFlags ( opt_ErrorSpans )
+import StaticFlags ( opt_ErrorSpans )
-import System.Exit ( ExitCode(..), exitWith )
+import System.Exit ( ExitCode(..), exitWith )
import Data.List
import qualified Data.Set as Set
import Data.IORef
@@ -84,13 +78,13 @@ printError span msg =
-- -----------------------------------------------------------------------------
-- Collecting up messages for later ordering and printing.
-data ErrMsg = ErrMsg {
- errMsgSpans :: [SrcSpan],
- errMsgContext :: PrintUnqualified,
- errMsgShortDoc :: Message,
- errMsgExtraInfo :: Message
- }
- -- The SrcSpan is used for sorting errors into line-number order
+data ErrMsg = ErrMsg {
+ errMsgSpans :: [SrcSpan],
+ errMsgContext :: PrintUnqualified,
+ errMsgShortDoc :: Message,
+ errMsgExtraInfo :: Message
+ }
+ -- The SrcSpan is used for sorting errors into line-number order
instance Show ErrMsg where
show em = showSDoc (errMsgShortDoc em)
@@ -113,7 +107,7 @@ mkPlainErrMsg locn msg
-- A long (multi-line) error message, with context to tell us whether
-- to qualify names in the message or not.
mkLongErrMsg :: SrcSpan -> PrintUnqualified -> Message -> Message -> ErrMsg
-mkLongErrMsg locn print_unqual msg extra
+mkLongErrMsg locn print_unqual msg extra
= ErrMsg { errMsgSpans = [locn], errMsgContext = print_unqual
, errMsgShortDoc = msg, errMsgExtraInfo = extra }
@@ -142,11 +136,11 @@ errorsFound :: DynFlags -> Messages -> Bool
errorsFound _dflags (_warns, errs) = not (isEmptyBag errs)
printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
-printBagOfErrors dflags bag_of_errors =
+printBagOfErrors dflags bag_of_errors =
printMsgBag dflags bag_of_errors SevError
printBagOfWarnings :: DynFlags -> Bag WarnMsg -> IO ()
-printBagOfWarnings dflags bag_of_warns =
+printBagOfWarnings dflags bag_of_warns =
printMsgBag dflags bag_of_warns SevWarning
pprErrMsgBag :: Bag ErrMsg -> [SDoc]
@@ -169,7 +163,7 @@ printMsgBag dflags bag sev
sortMsgBag :: Bag ErrMsg -> [ErrMsg]
sortMsgBag bag = sortLe srcOrder $ bagToList bag
where
- srcOrder err1 err2 =
+ srcOrder err1 err2 =
case compare (head (errMsgSpans err1)) (head (errMsgSpans err2)) of
LT -> True
EQ -> True
@@ -179,15 +173,15 @@ ghcExit :: DynFlags -> Int -> IO ()
ghcExit dflags val
| val == 0 = exitWith ExitSuccess
| otherwise = do errorMsg dflags (text "\nCompilation had errors\n\n")
- exitWith (ExitFailure val)
+ exitWith (ExitFailure val)
doIfSet :: Bool -> IO () -> IO ()
doIfSet flag action | flag = action
- | otherwise = return ()
+ | otherwise = return ()
doIfSet_dyn :: DynFlags -> DynFlag -> IO () -> IO()
doIfSet_dyn dflags flag action | dopt flag dflags = action
- | otherwise = return ()
+ | otherwise = return ()
-- -----------------------------------------------------------------------------
-- Dumping
@@ -199,7 +193,7 @@ dumpIfSet flag hdr doc
dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpIfSet_dyn dflags flag hdr doc
- | dopt flag dflags || verbosity dflags >= 4
+ | dopt flag dflags || verbosity dflags >= 4
= dumpSDoc dflags flag hdr doc
| otherwise
= return ()
@@ -212,18 +206,18 @@ dumpIfSet_dyn_or dflags (flag : flags) hdr doc
else dumpIfSet_dyn_or dflags flags hdr doc
mkDumpDoc :: String -> SDoc -> SDoc
-mkDumpDoc hdr doc
+mkDumpDoc hdr doc
= vcat [blankLine,
- line <+> text hdr <+> line,
- doc,
- blankLine]
- where
+ line <+> text hdr <+> line,
+ doc,
+ blankLine]
+ where
line = text (replicate 20 '=')
-- | Write out a dump.
--- If --dump-to-file is set then this goes to a file.
--- otherwise emit to stdout.
+-- If --dump-to-file is set then this goes to a file.
+-- otherwise emit to stdout.
dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpSDoc dflags dflag hdr doc
= do let mFile = chooseDumpFile dflags dflag
@@ -253,36 +247,31 @@ dumpSDoc dflags dflag hdr doc
chooseDumpFile :: DynFlags -> DynFlag -> Maybe String
chooseDumpFile dflags dflag
- -- dump file location is being forced
- -- by the --ddump-file-prefix flag.
- | dumpToFile
- , Just prefix <- dumpPrefixForce dflags
- = Just $ prefix ++ (beautifyDumpName dflag)
+ -- dump file location is being forced
+ -- by the --ddump-file-prefix flag.
+ | dumpToFile
+ , Just prefix <- dumpPrefixForce dflags
+ = Just $ prefix ++ (beautifyDumpName dflag)
- -- dump file location chosen by DriverPipeline.runPipeline
- | dumpToFile
- , Just prefix <- dumpPrefix dflags
- = Just $ prefix ++ (beautifyDumpName dflag)
+ -- dump file location chosen by DriverPipeline.runPipeline
+ | dumpToFile
+ , Just prefix <- dumpPrefix dflags
+ = Just $ prefix ++ (beautifyDumpName dflag)
- -- we haven't got a place to put a dump file.
- | otherwise
- = Nothing
+ -- we haven't got a place to put a dump file.
+ | otherwise
+ = Nothing
- where dumpToFile = dopt Opt_DumpToFile dflags
+ where dumpToFile = dopt Opt_DumpToFile dflags
-- | Build a nice file name from name of a DynFlag constructor
beautifyDumpName :: DynFlag -> String
beautifyDumpName dflag
- = let str = show dflag
- cut = if isPrefixOf "Opt_D_" str
- then drop 6 str
- else str
- dash = map (\c -> case c of
- '_' -> '-'
- _ -> c)
- cut
- in dash
+ = let str = show dflag
+ cut = if isPrefixOf "Opt_D_" str then drop 6 str else str
+ dash = map (\c -> if c == '_' then '-' else c) cut
+ in dash
-- -----------------------------------------------------------------------------
@@ -321,10 +310,11 @@ compilationProgressMsg dflags msg
= ifVerbose dflags 1 (log_action dflags SevOutput noSrcSpan defaultUserStyle (text msg))
showPass :: DynFlags -> String -> IO ()
-showPass dflags what
+showPass dflags what
= ifVerbose dflags 2 (log_action dflags SevInfo noSrcSpan defaultUserStyle (text "***" <+> text what <> colon))
debugTraceMsg :: DynFlags -> Int -> Message -> IO ()
debugTraceMsg dflags val msg
= ifVerbose dflags val (log_action dflags SevInfo noSrcSpan defaultDumpStyle msg)
\end{code}
+
diff --git a/compiler/main/ErrUtils.lhs-boot b/compiler/main/ErrUtils.lhs-boot
index a4e1cab76b..08115a4b48 100644
--- a/compiler/main/ErrUtils.lhs-boot
+++ b/compiler/main/ErrUtils.lhs-boot
@@ -15,3 +15,4 @@ type Message = SDoc
mkLocMessage :: SrcSpan -> Message -> Message
\end{code}
+
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 6b7e953fc9..87c723f958 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -27,7 +27,7 @@
-------------------------------------------------------------------------------
module HscMain
- (
+ (
-- * Making an HscEnv
newHscEnv
@@ -183,7 +183,7 @@ newHscEnv dflags = do
knownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta,
knownKeyNames = -- where templateHaskellNames are defined
- map getName wiredInThings
+ map getName wiredInThings
++ basicKnownKeyNames
#ifdef GHCI
++ templateHaskellNames
@@ -279,12 +279,12 @@ ioMsgMaybe' ioA = do
#ifdef GHCI
hscTcRnLookupRdrName :: HscEnv -> RdrName -> IO [Name]
-hscTcRnLookupRdrName hsc_env rdr_name =
+hscTcRnLookupRdrName hsc_env rdr_name =
runHsc hsc_env $ ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name
#endif
hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
-hscTcRcLookupName hsc_env name =
+hscTcRcLookupName hsc_env name =
runHsc hsc_env $ ioMsgMaybe' $ tcRnLookupName hsc_env name
-- ignore errors: the only error we're likely to get is
-- "name not found", and the Maybe in the return type
@@ -348,7 +348,7 @@ hscParse' mod_summary = do
-- XXX: should this really be a Maybe X? Check under which circumstances this
-- can become a Nothing and decide whether this should instead throw an
-- exception/signal an error.
-type RenamedStuff =
+type RenamedStuff =
(Maybe (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
Maybe LHsDocString))
@@ -357,7 +357,7 @@ hscTypecheckRename :: HscEnv -> ModSummary -> Located (HsModule RdrName)
-> IO (TcGblEnv, RenamedStuff)
hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do
tc_result <- {-# SCC "Typecheck-Rename" #-}
- ioMsgMaybe $
+ ioMsgMaybe $
tcRnModule hsc_env (ms_hsc_src mod_summary)
True rdr_module
@@ -393,7 +393,7 @@ hscDesugar' mod_summary tc_result = do
makeSimpleIface :: HscEnv -> Maybe ModIface -> TcGblEnv -> ModDetails
-> IO (ModIface,Bool)
makeSimpleIface hsc_env maybe_old_iface tc_result details =
- runHsc hsc_env $ ioMsgMaybe $
+ runHsc hsc_env $ ioMsgMaybe $
mkIfaceTc hsc_env (fmap mi_iface_hash maybe_old_iface) details tc_result
-- | Make a 'ModDetails' from the results of typechecking. Used when
@@ -509,7 +509,7 @@ genericHscCompile compiler hscMessage hsc_env
= do
(recomp_reqd, mb_checked_iface)
<- {-# SCC "checkOldIface" #-}
- checkOldIface hsc_env mod_summary
+ checkOldIface hsc_env mod_summary
source_modified mb_old_iface0
-- save the interface that comes back from checkOldIface.
-- In one-shot mode we don't have the old iface until this
@@ -559,7 +559,7 @@ hscCheckRecompBackend compiler tc_result hsc_env mod_summary
let mb_old_hash = fmap mi_iface_hash mb_checked_iface
case mb_checked_iface of
Just iface | not recomp_reqd
- -> runHsc hsc_env $
+ -> runHsc hsc_env $
hscNoRecomp compiler
iface{ mi_globals = Just (tcg_rdr_env tc_result) }
_otherwise
@@ -917,7 +917,7 @@ checkSafeImports dflags hsc_env tcg_env
case safeInferOn dflags of
True -> wipeTrust tcg_env errs
False -> liftIO . throwIO . mkSrcErr $ errs
-
+
-- All good matey!
False -> do
when (packageTrustOn dflags) $ checkPkgTrust pkg_reqs
@@ -938,7 +938,7 @@ checkSafeImports dflags hsc_env tcg_env
-- inference mode is on.
let s' = if safeInferOn dflags then True else s
return (m, l, s')
-
+
-- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
cond' v1@(m1,_,l1,s1) (_,_,_,s2)
@@ -1084,12 +1084,12 @@ hscSimplify' ds_result = do
hscSimpleIface :: TcGblEnv
-> Maybe Fingerprint
-> Hsc (ModIface, Bool, ModDetails)
-hscSimpleIface tc_result mb_old_iface = do
+hscSimpleIface tc_result mb_old_iface = do
hsc_env <- getHscEnv
details <- liftIO $ mkBootModDetailsTc hsc_env tc_result
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
- ioMsgMaybe $
+ ioMsgMaybe $
mkIfaceTc hsc_env mb_old_iface details tc_result
-- And the answer is ...
liftIO $ dumpIfaceStats hsc_env
@@ -1098,7 +1098,7 @@ hscSimpleIface tc_result mb_old_iface = do
hscNormalIface :: ModGuts
-> Maybe Fingerprint
-> Hsc (ModIface, Bool, ModDetails, CgGuts)
-hscNormalIface simpl_result mb_old_iface = do
+hscNormalIface simpl_result mb_old_iface = do
hsc_env <- getHscEnv
(cg_guts, details) <- {-# SCC "CoreTidy" #-}
liftIO $ tidyProgram hsc_env simpl_result
@@ -1110,7 +1110,7 @@ hscNormalIface simpl_result mb_old_iface = do
-- until after code output
(new_iface, no_change)
<- {-# SCC "MkFinalIface" #-}
- ioMsgMaybe $
+ ioMsgMaybe $
mkIface hsc_env mb_old_iface details simpl_result
-- Emit external core
@@ -1162,13 +1162,13 @@ hscGenHardCode cgguts mod_summary = do
----------------- Convert to STG ------------------
(stg_binds, cost_centre_info)
<- {-# SCC "CoreToStg" #-}
- myCoreToStg dflags this_mod prepd_binds
+ myCoreToStg dflags this_mod prepd_binds
let prof_init = profilingInitCode platform this_mod cost_centre_info
foreign_stubs = foreign_stubs0 `appendStubC` prof_init
------------------ Code generation ------------------
-
+
cmms <- if dopt Opt_TryNewCodeGen dflags
then tryNewCodeGen hsc_env this_mod data_tycons
cost_centre_info
@@ -1182,7 +1182,7 @@ hscGenHardCode cgguts mod_summary = do
rawcmms <- cmmToRawCmm platform cmms
dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (pprPlatform platform rawcmms)
(_stub_h_exists, stub_c_exists)
- <- codeOutput dflags this_mod location foreign_stubs
+ <- codeOutput dflags this_mod location foreign_stubs
dependencies rawcmms
return stub_c_exists
@@ -1214,7 +1214,7 @@ hscInteractive (iface, details, cgguts) mod_summary = do
comp_bc <- liftIO $ byteCodeGen dflags this_mod prepd_binds
data_tycons mod_breaks
------------------ Create f-x-dynamic C-side stuff ---
- (_istub_h_exists, istub_c_exists)
+ (_istub_h_exists, istub_c_exists)
<- liftIO $ outputForeignStubs dflags this_mod
location foreign_stubs
return (HscRecomp istub_c_exists (Just (comp_bc, mod_breaks))
@@ -1252,7 +1252,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
platform = targetPlatform dflags
prog <- StgCmm.codeGen dflags this_mod data_tycons
cost_centre_info stg_binds hpc_info
- dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
+ dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
(pprCmms platform prog)
-- We are building a single SRT for the entire module, so
@@ -1268,7 +1268,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
myCoreToStg :: DynFlags -> Module -> CoreProgram
-> IO ( [(StgBinding,[(Id,[Id])])] -- output program
, CollectedCCs) -- cost centre info (declared and used)
-myCoreToStg dflags this_mod prepd_binds = do
+myCoreToStg dflags this_mod prepd_binds = do
stg_binds
<- {-# SCC "Core2Stg" #-}
coreToStg dflags prepd_binds
@@ -1289,7 +1289,7 @@ myCoreToStg dflags this_mod prepd_binds = do
{-
When the UnlinkedBCOExpr is linked you get an HValue of type
IO [HValue]
-When you run it you get a list of HValues that should be
+When you run it you get a list of HValues that should be
the same length as the list of names; add them to the ClosureEnv.
A naked expression returns a singleton Name [it].
@@ -1304,13 +1304,13 @@ A naked expression returns a singleton Name [it].
expr (of IO type) ==> expr >>= \ v -> return [v]
[NB: result not printed] bindings: [it]
-
- expr (of non-IO type,
+
+ expr (of non-IO type,
result showable) ==> let v = expr in print v >> return [v]
bindings: [it]
- expr (of non-IO type,
+ expr (of non-IO type,
result not showable) ==> error
-}
@@ -1333,7 +1333,7 @@ hscStmtWithLocation hsc_env stmt source linenumber = runHsc hsc_env $ do
maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
case maybe_stmt of
Nothing -> return Nothing
-
+
-- The real stuff
Just parsed_stmt -> do
-- Rename and typecheck it
@@ -1366,16 +1366,16 @@ hscDeclsWithLocation :: HscEnv
-> String -- ^ The source
-> Int -- ^ Starting line
-> IO ([TyThing], InteractiveContext)
-hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do
+hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do
L _ (HsModule{ hsmodDecls = decls }) <-
hscParseThingWithLocation source linenumber parseModule str
-
+
{- Rename and typecheck it -}
let icontext = hsc_IC hsc_env
tc_gblenv <- ioMsgMaybe $ tcRnDeclsi hsc_env icontext decls
{- Grab the new instances -}
- -- We grab the whole environment because of the overlapping that may have
+ -- We grab the whole environment because of the overlapping that may have
-- been done. See the notes at the definition of InteractiveContext
-- (ic_instances) for more details.
let finsts = famInstEnvElts $ tcg_fam_inst_env tc_gblenv
@@ -1434,12 +1434,12 @@ hscDeclsWithLocation hsc_env str source linenumber = runHsc hsc_env $ do
let ictxt1 = extendInteractiveContext icontext tythings
ictxt = ictxt1 { ic_sys_vars = sys_vars ++ ic_sys_vars ictxt1,
ic_instances = (insts, finsts) }
-
+
return (tythings, ictxt)
hscImport :: HscEnv -> String -> IO (ImportDecl RdrName)
hscImport hsc_env str = runHsc hsc_env $ do
- (L _ (HsModule{hsmodImports=is})) <-
+ (L _ (HsModule{hsmodImports=is})) <-
hscParseThing parseModule str
case is of
[i] -> return (unLoc i)
@@ -1475,7 +1475,7 @@ hscParseStmt = hscParseThing parseStmt
hscParseStmtWithLocation :: String -> Int -> String
-> Hsc (Maybe (LStmt RdrName))
-hscParseStmtWithLocation source linenumber stmt =
+hscParseStmtWithLocation source linenumber stmt =
hscParseThingWithLocation source linenumber parseStmt stmt
hscParseType :: String -> Hsc (LHsType RdrName)
@@ -1489,7 +1489,7 @@ hscParseIdentifier hsc_env str =
hscParseThing :: (Outputable thing) => Lexer.P thing -> String -> Hsc thing
hscParseThing = hscParseThingWithLocation "<interactive>" 1
-hscParseThingWithLocation :: (Outputable thing) => String -> Int
+hscParseThingWithLocation :: (Outputable thing) => String -> Int
-> Lexer.P thing -> String -> Hsc thing
hscParseThingWithLocation source linenumber parser str
= {-# SCC "Parser" #-} do
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 3391f6a5ed..eee8bb2e06 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -6,7 +6,7 @@
\begin{code}
-- | Types for the per-module compiler
-module HscTypes (
+module HscTypes (
-- * compilation state
HscEnv(..), hscEPS,
FinderCache, FindResult(..), ModLocationCache,
@@ -24,7 +24,7 @@ module HscTypes (
-- * Information about the module being compiled
HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
-
+
-- * State relating to modules in this package
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
hptInstances, hptRules, hptVectInfo,
@@ -34,17 +34,17 @@ module HscTypes (
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
lookupIfaceByModule, emptyModIface,
-
+
PackageInstEnv, PackageRuleBase,
-- * Annotations
prepareAnnotations,
-- * Interactive context
- InteractiveContext(..), emptyInteractiveContext,
+ InteractiveContext(..), emptyInteractiveContext,
icPrintUnqual, icInScopeTTs, icPlusGblRdrEnv,
extendInteractiveContext, substInteractiveContext,
- InteractiveImport(..),
+ InteractiveImport(..),
mkPrintUnqualified, pprModulePrefix,
-- * Interfaces
@@ -60,7 +60,7 @@ module HscTypes (
tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyVars,
implicitTyThings, implicitTyConThings, implicitClassThings,
isImplicitTyThing,
-
+
TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
typeEnvFromEntities, mkTypeEnvWithImplicits,
extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
@@ -71,7 +71,7 @@ module HscTypes (
MonadThings(..),
-- * Information on imports and exports
- WhetherHasOrphans, IsBootInterface, Usage(..),
+ WhetherHasOrphans, IsBootInterface, Usage(..),
Dependencies(..), noDependencies,
NameCache(..), OrigNameCache, OrigIParamCache,
IfaceExport,
@@ -83,7 +83,7 @@ module HscTypes (
Linkable(..), isObjectLinkable, linkableObjs,
Unlinked(..), CompiledByteCode,
isObject, nameOfObject, isInterpretable, byteCodeOfObject,
-
+
-- * Program coverage
HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
@@ -91,7 +91,7 @@ module HscTypes (
ModBreaks (..), BreakIndex, emptyModBreaks,
-- * Vectorisation information
- VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
+ VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
noIfaceVectInfo,
-- * Safe Haskell information
@@ -122,13 +122,13 @@ import Rules ( RuleBase )
import CoreSyn ( CoreProgram )
import Name
import NameEnv
-import NameSet
+import NameSet
import VarEnv
import VarSet
import Var
import Id
import IdInfo ( IdDetails(..) )
-import Type
+import Type
import Annotations
import Class
@@ -242,7 +242,7 @@ handleFlagWarnings dflags warns
= when (wopt Opt_WarnDeprecatedFlags dflags) $ do
-- It would be nicer if warns :: [Located Message], but that
-- has circular import problems.
- let bag = listToBag [ mkPlainWarnMsg loc (text warn)
+ let bag = listToBag [ mkPlainWarnMsg loc (text warn)
| L loc warn <- warns ]
printOrThrowWarnings dflags bag
@@ -266,8 +266,8 @@ handleFlagWarnings dflags warns
-- module, the driver would invoke hsc on the source code... so nowadays
-- we think of hsc as the layer of the compiler that deals with compiling
-- a single module.
-data HscEnv
- = HscEnv {
+data HscEnv
+ = HscEnv {
hsc_dflags :: DynFlags,
-- ^ The dynamic flag settings
@@ -282,7 +282,7 @@ data HscEnv
hsc_HPT :: HomePackageTable,
-- ^ The home package table describes already-compiled
- -- home-package modules, /excluding/ the module we
+ -- home-package modules, /excluding/ the module we
-- are compiling right now.
-- (In one-shot mode the current module is the only
-- home-package module, so hsc_HPT is empty. All other
@@ -290,21 +290,21 @@ data HscEnv
-- However, even in GHCi mode, hi-boot interfaces are
-- demand-loaded into the external-package table.)
--
- -- 'hsc_HPT' is not mutable because we only demand-load
- -- external packages; the home package is eagerly
+ -- 'hsc_HPT' is not mutable because we only demand-load
+ -- external packages; the home package is eagerly
-- loaded, module by module, by the compilation manager.
- --
+ --
-- The HPT may contain modules compiled earlier by @--make@
-- but not actually below the current module in the dependency
-- graph.
- --
+ --
-- (This changes a previous invariant: changed Jan 05.)
-
+
hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
-- ^ Information about the currently loaded external packages.
-- This is mutable because packages will be demand-loaded during
-- a compilation run as required.
-
+
hsc_NC :: {-# UNPACK #-} !(IORef NameCache),
-- ^ As with 'hsc_EPS', this is side-effected by compiling to
-- reflect sucking in interface files. They cache the state of
@@ -313,7 +313,7 @@ data HscEnv
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
-- ^ The cached result of performing finding in the file system
hsc_MLC :: {-# UNPACK #-} !(IORef ModLocationCache),
- -- ^ This caches the location of modules, so we don't have to
+ -- ^ This caches the location of modules, so we don't have to
-- search the filesystem multiple times. See also 'hsc_FC'.
hsc_OptFuel :: OptFuelState,
@@ -323,7 +323,7 @@ data HscEnv
hsc_type_env_var :: Maybe (Module, IORef TypeEnv),
-- ^ Used for one-shot compilation only, to initialise
- -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
+ -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
-- 'TcRunTypes.TcGblEnv'
hsc_safeInf :: {-# UNPACK #-} !(IORef Bool)
@@ -368,7 +368,7 @@ data TargetId
deriving Eq
pprTarget :: Target -> SDoc
-pprTarget (Target id obj _) =
+pprTarget (Target id obj _) =
(if obj then char '*' else empty) <> pprTargetId id
instance Outputable Target where
@@ -407,7 +407,7 @@ emptyPackageIfaceTable :: PackageIfaceTable
emptyPackageIfaceTable = emptyModuleEnv
-- | Information about modules in the package being compiled
-data HomeModInfo
+data HomeModInfo
= HomeModInfo {
hm_iface :: !ModIface,
-- ^ The basic loaded interface file: every loaded module has one of
@@ -447,10 +447,10 @@ lookupIfaceByModule dflags hpt pit mod
-- The module comes from the home package, so look first
-- in the HPT. If it's not from the home package it's wrong to look
-- in the HPT, because the HPT is indexed by *ModuleName* not Module
- = fmap hm_iface (lookupUFM hpt (moduleName mod))
+ = fmap hm_iface (lookupUFM hpt (moduleName mod))
`mplus` lookupModuleEnv pit mod
- | otherwise = lookupModuleEnv pit mod -- Look in PIT only
+ | otherwise = lookupModuleEnv pit mod -- Look in PIT only
-- If the module does come from the home package, why do we look in the PIT as well?
-- (a) In OneShot mode, even home-package modules accumulate in the PIT
@@ -474,7 +474,7 @@ hptInstances hsc_env want_this_module
-- | Get the combined VectInfo of all modules in the home package table. In
-- contrast to instances and rules, we don't care whether the modules are
--- "below" us in the dependency sense. The VectInfo of those modules not "below"
+-- "below" us in the dependency sense. The VectInfo of those modules not "below"
-- us does not affect the compilation of the current module.
hptVectInfo :: HscEnv -> VectInfo
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
@@ -515,7 +515,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
-- Look it up in the HPT
, let things = case lookupUFM hpt mod of
Just info -> extract info
- Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
+ Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
msg = vcat [ptext (sLit "missing module") <+> ppr mod,
ptext (sLit "Probable cause: out-of-date interface files")]
-- This really shouldn't happen, but see Trac #962
@@ -534,7 +534,7 @@ hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
%************************************************************************
\begin{code}
--- | Deal with gathering annotations in from all possible places
+-- | Deal with gathering annotations in from all possible places
-- and combining them into a single 'AnnEnv'
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
prepareAnnotations hsc_env mb_guts = do
@@ -546,8 +546,8 @@ prepareAnnotations hsc_env mb_guts = do
-- entries regardless of dependency ordering.
home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
other_pkg_anns = eps_ann_env eps
- ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
- Just home_pkg_anns,
+ ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
+ Just home_pkg_anns,
Just other_pkg_anns]
return ann_env
\end{code}
@@ -577,7 +577,7 @@ data FindResult
-- ^ The requested package was not found
| FoundMultiple [PackageId]
-- ^ _Error_: both in multiple packages
-
+
-- | Not found
| NotFound
{ fr_paths :: [FilePath] -- Places where I looked
@@ -608,16 +608,16 @@ type ModLocationCache = ModuleEnv ModLocation
%************************************************************************
\begin{code}
--- | A 'ModIface' plus a 'ModDetails' summarises everything we know
+-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
-- about a compiled module. The 'ModIface' is the stuff *before* linking,
--- and can be written out to an interface file. The 'ModDetails is after
+-- and can be written out to an interface file. The 'ModDetails is after
-- linking and can be completely recovered from just the 'ModIface'.
---
+--
-- When we read an interface file, we also construct a 'ModIface' from it,
-- except that we explicitly make the 'mi_decls' and a few other fields empty;
-- as when reading we consolidate the declarations etc. into a number of indexed
-- maps and environments in the 'ExternalPackageState'.
-data ModIface
+data ModIface
= ModIface {
mi_module :: !Module, -- ^ Name of the module we are for
mi_iface_hash :: !Fingerprint, -- ^ Hash of the whole interface
@@ -646,7 +646,7 @@ data ModIface
-- Kept sorted by (mod,occ), to make version comparisons easier
-- Records the modules that are the declaration points for things
-- exported by this module, and the 'OccName's of those things
-
+
mi_exp_hash :: !Fingerprint,
-- ^ Hash of export list
@@ -671,7 +671,7 @@ data ModIface
-- ^ Type, class and variable declarations
-- The hash of an Id changes if its fixity or deprecations change
-- (as well as its type of course)
- -- Ditto data constructors, class operations, except that
+ -- Ditto data constructors, class operations, except that
-- the hash of the parent class/tycon changes
mi_globals :: !(Maybe GlobalRdrEnv),
@@ -758,7 +758,7 @@ emptyModIface mod
mi_hash_fn = emptyIfaceHashCache,
mi_hpc = False,
mi_trust = noIfaceTrustInfo,
- mi_trust_pkg = False }
+ mi_trust_pkg = False }
-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
-- for home modules only. Information relating to packages will be loaded into
@@ -771,7 +771,7 @@ data ModDetails
md_insts :: ![Instance], -- ^ 'DFunId's for the instances in this module
md_fam_insts :: ![FamInst],
md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules
- md_anns :: ![Annotation], -- ^ Annotations present in this module: currently
+ md_anns :: ![Annotation], -- ^ Annotations present in this module: currently
-- they only annotate things also declared in this module
md_vect_info :: !VectInfo -- ^ Module vectorisation information
}
@@ -785,7 +785,7 @@ emptyModDetails
md_rules = [],
md_fam_insts = [],
md_anns = [],
- md_vect_info = noVectInfo }
+ md_vect_info = noVectInfo }
-- | Records the modules directly imported by a module for extracting e.g. usage information
type ImportedMods = ModuleEnv [ImportedModsVal]
@@ -793,7 +793,7 @@ type ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
--- being compiled right now. Once it is compiled, a 'ModIface' and
+-- being compiled right now. Once it is compiled, a 'ModIface' and
-- 'ModDetails' are extracted and the ModGuts is discarded.
data ModGuts
= ModGuts {
@@ -816,7 +816,7 @@ data ModGuts
-- (includes TyCons for classes)
mg_insts :: ![Instance], -- ^ Class instances declared in this module
mg_fam_insts :: ![FamInst], -- ^ Family instances declared in this module
- mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
+ mg_rules :: ![CoreRule], -- ^ Before the core pipeline starts, contains
-- See Note [Overall plumbing for rules] in Rules.lhs
mg_binds :: !CoreProgram, -- ^ Bindings for this module
mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module
@@ -830,7 +830,7 @@ data ModGuts
-- The next two fields are unusual, because they give instance
-- environments for *all* modules in the home package, including
- -- this module, rather than for *just* this module.
+ -- this module, rather than for *just* this module.
-- Reason: when looking up an instance we don't want to have to
-- look at each module in the home package in turn
mg_inst_env :: InstEnv,
@@ -853,13 +853,13 @@ data ModGuts
---------------------------------------------------------
--- The Tidy pass forks the information about this module:
+-- The Tidy pass forks the information about this module:
-- * one lot goes to interface file generation (ModIface)
-- and later compilations (ModDetails)
-- * the other lot goes to code generation (CgGuts)
-- | A restricted form of 'ModGuts' for code generation purposes
-data CgGuts
+data CgGuts
= CgGuts {
cg_module :: !Module,
-- ^ Module being compiled
@@ -878,7 +878,7 @@ data CgGuts
-- as part of the code-gen of tycons
cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs
- cg_dep_pkgs :: ![PackageId], -- ^ Dependent packages, used to
+ cg_dep_pkgs :: ![PackageId], -- ^ Dependent packages, used to
-- generate #includes for C code gen
cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information
cg_modBreaks :: !ModBreaks -- ^ Module breakpoints
@@ -912,8 +912,8 @@ appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
\begin{code}
-- | Interactive context, recording information about the state of the
-- context in which statements are executed in a GHC session.
-data InteractiveContext
- = InteractiveContext {
+data InteractiveContext
+ = InteractiveContext {
ic_imports :: [InteractiveImport],
-- ^ The GHCi context is extended with these imports
--
@@ -992,13 +992,13 @@ icInScopeTTs = ic_tythings
-- | Get the PrintUnqualified function based on the flags and this InteractiveContext
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
-icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
+icPrintUnqual dflags InteractiveContext{ ic_rn_gbl_env = grenv } =
mkPrintUnqualified dflags grenv
--- | This function is called with new TyThings recently defined to update the
+-- | This function is called with new TyThings recently defined to update the
-- InteractiveContext to include them. Ids are easily removed when shadowed,
--- but Classes and TyCons are not. Some work could be done to determine
--- whether they are entirely shadowed, but as you could still have references
+-- but Classes and TyCons are not. Some work could be done to determine
+-- whether they are entirely shadowed, but as you could still have references
-- to them (e.g. instances for classes or values of the type for TyCons), it's
-- not clear whether removing them is even the appropriate behavior.
extendInteractiveContext :: InteractiveContext -> [TyThing] -> InteractiveContext
@@ -1027,7 +1027,7 @@ substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
substInteractiveContext ictxt subst
| isEmptyTvSubst subst = ictxt
-substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
+substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
= ictxt { ic_tythings = map subst_ty tts }
where subst_ty (AnId id) = AnId $ id `setIdType` substTy subst (idType id)
subst_ty tt = tt
@@ -1050,7 +1050,7 @@ instance Outputable InteractiveImport where
%************************************************************************
%* *
- Building a PrintUnqualified
+ Building a PrintUnqualified
%* *
%************************************************************************
@@ -1066,7 +1066,7 @@ scope. However, the name might not be in scope at all, and that's
where it gets tricky. Here are the cases:
1. T uniquely maps to P:M.T ---> "T" NameUnqual
- 2. There is an X for which X.T
+ 2. There is an X for which X.T
uniquely maps to P:M.T ---> "X.T" NameQual X
3. There is no binding for "M.T" ---> "M.T" NameNotInScope1
4. Otherwise ---> "P:M.T" NameNotInScope2
@@ -1097,7 +1097,7 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
| [gre] <- qual_gres = NameQual (get_qual_mod (gre_prov gre))
- | null qual_gres =
+ | null qual_gres =
if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
then NameNotInScope1
else NameNotInScope2
@@ -1127,7 +1127,7 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
qual_mod mod
| modulePackageId mod == thisPackage dflags = False
- | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup,
+ | [pkgconfig] <- [pkg | (pkg,exposed_module) <- lookup,
exposed pkg && exposed_module],
packageConfigId pkgconfig == modulePackageId mod
-- this says: we are given a module P:M, is there just one exposed package
@@ -1182,12 +1182,12 @@ implicitTyThings (ACoAxiom _cc) = []
implicitTyThings (ATyCon tc) = implicitTyConThings tc
implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
-- For data cons add the worker and (possibly) wrapper
-
+
implicitClassThings :: Class -> [TyThing]
-implicitClassThings cl
+implicitClassThings cl
= -- Does not include default methods, because those Ids may have
-- their own pragmas, unfoldings etc, not derived from the Class object
- -- associated types
+ -- associated types
-- No extras_plus (recursive call) for the classATs, because they
-- are only the family decls; they have no implicit things
map ATyCon (classATs cl) ++
@@ -1195,7 +1195,7 @@ implicitClassThings cl
map AnId (classAllSelIds cl)
implicitTyConThings :: TyCon -> [TyThing]
-implicitTyConThings tc
+implicitTyConThings tc
= class_stuff ++
-- fields (names of selectors)
-- (possibly) implicit coercion and family coercion
@@ -1218,11 +1218,11 @@ extras_plus thing = thing : implicitTyThings thing
-- For newtypes and indexed data types (and both),
-- add the implicit coercion tycon
implicitCoTyCon :: TyCon -> [TyThing]
-implicitCoTyCon tc
+implicitCoTyCon tc
= map ACoAxiom . catMaybes $ [-- Just if newtype, Nothing if not
newTyConCo_maybe tc,
-- Just if family instance, Nothing if not
- tyConFamilyCoercion_maybe tc]
+ tyConFamilyCoercion_maybe tc]
-- | Returns @True@ if there should be no interface-file declaration
-- for this thing on its own: either it is built-in, or it is part
@@ -1301,18 +1301,18 @@ lookupTypeEnv :: TypeEnv -> Name -> Maybe TyThing
emptyTypeEnv = emptyNameEnv
typeEnvElts env = nameEnvElts env
-typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
-typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
-typeEnvIds env = [id | AnId id <- typeEnvElts env]
-typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env]
+typeEnvTyCons env = [tc | ATyCon tc <- typeEnvElts env]
+typeEnvCoAxioms env = [ax | ACoAxiom ax <- typeEnvElts env]
+typeEnvIds env = [id | AnId id <- typeEnvElts env]
+typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env]
typeEnvClasses env = [cl | tc <- typeEnvTyCons env,
Just cl <- [tyConClass_maybe tc]]
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
-
+
mkTypeEnvWithImplicits :: [TyThing] -> TypeEnv
-mkTypeEnvWithImplicits things =
+mkTypeEnvWithImplicits things =
mkTypeEnv things
`plusNameEnv`
mkTypeEnv (concatMap implicitTyThings things)
@@ -1330,7 +1330,7 @@ lookupTypeEnv = lookupNameEnv
-- Extend the type environment
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
-extendTypeEnv env thing = extendNameEnv env (getName thing) thing
+extendTypeEnv env thing = extendNameEnv env (getName thing) thing
extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList env things = foldl extendTypeEnv env things
@@ -1355,7 +1355,7 @@ lookupType :: DynFlags
lookupType dflags hpt pte name
-- in one-shot, we don't use the HPT
- | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg
+ | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg
= do hm <- lookupUFM hpt (moduleName mod) -- Maybe monad
lookupNameEnv (md_types (hm_details hm)) name
| otherwise
@@ -1369,7 +1369,7 @@ lookupTypeHscEnv :: HscEnv -> Name -> IO (Maybe TyThing)
lookupTypeHscEnv hsc_env name = do
eps <- readIORef (hsc_EPS hsc_env)
return $! lookupType dflags hpt (eps_PTE eps) name
- where
+ where
dflags = hsc_dflags hsc_env
hpt = hsc_HPT hsc_env
\end{code}
@@ -1425,7 +1425,7 @@ class Monad m => MonadThings m where
-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
-> (OccName -> Maybe (OccName, Fingerprint))
-mkIfaceHashCache pairs
+mkIfaceHashCache pairs
= \occ -> lookupOccEnv env occ
where
env = foldr add_decl emptyOccEnv pairs
@@ -1498,7 +1498,7 @@ plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2)
\begin{code}
-- | Creates cached lookup for the 'mi_fix_fn' field of 'ModIface'
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
-mkIfaceFixCache pairs
+mkIfaceFixCache pairs
= \n -> lookupOccEnv env n `orElse` defaultFixity
where
env = mkOccEnv pairs
@@ -1509,7 +1509,7 @@ emptyIfaceFixCache _ = defaultFixity
-- | Fixity environment mapping names to their fixities
type FixityEnv = NameEnv FixItem
--- | Fixity information for an 'Name'. We keep the OccName in the range
+-- | Fixity information for an 'Name'. We keep the OccName in the range
-- so that we can generate an interface from it
data FixItem = FixItem OccName Fixity
@@ -1596,7 +1596,7 @@ data Usage
-- ^ Cached module fingerprint
usg_entities :: [(OccName,Fingerprint)],
-- ^ Entities we depend on, sorted by occurrence name and fingerprinted.
- -- NB: usages are for parent names only, e.g. type constructors
+ -- NB: usages are for parent names only, e.g. type constructors
-- but not the associated data constructors.
usg_exports :: Maybe Fingerprint,
-- ^ Fingerprint for the export list we used to depend on this module,
@@ -1612,9 +1612,9 @@ data Usage
deriving( Eq )
-- The export list field is (Just v) if we depend on the export list:
-- i.e. we imported the module directly, whether or not we
- -- enumerated the things we imported, or just imported
+ -- enumerated the things we imported, or just imported
-- everything
- -- We need to recompile if M's exports change, because
+ -- We need to recompile if M's exports change, because
-- if the import was import M, we might now have a name clash
-- in the importing module.
-- if the import was import M(x) M might no longer export x
@@ -1661,7 +1661,7 @@ data ExternalPackageState
-- whose interfaces we have opened.
-- The declarations in these interface files are held in the
-- 'eps_decls', 'eps_inst_env', 'eps_fam_inst_env' and 'eps_rules'
- -- fields of this record, not in the 'mi_decls' fields of the
+ -- fields of this record, not in the 'mi_decls' fields of the
-- interface we have sucked in.
--
-- What /is/ in the PIT is:
@@ -1676,11 +1676,11 @@ data ExternalPackageState
--
-- * Deprecations and warnings
- eps_PTE :: !PackageTypeEnv,
+ eps_PTE :: !PackageTypeEnv,
-- ^ Result of typechecking all the external package
-- interface files we have sucked in. The domain of
-- the mapping is external-package modules
-
+
eps_inst_env :: !PackageInstEnv, -- ^ The total 'InstEnv' accumulated
-- from all the external-package modules
eps_fam_inst_env :: !PackageFamInstEnv,-- ^ The total 'FamInstEnv' accumulated
@@ -1702,7 +1702,7 @@ data ExternalPackageState
-- \"In\" means stuff that is just /read/ from interface files,
-- \"Out\" means actually sucked in and type-checked
data EpsStats = EpsStats { n_ifaces_in
- , n_decls_in, n_decls_out
+ , n_decls_in, n_decls_out
, n_rules_in, n_rules_out
, n_insts_in, n_insts_out :: !Int }
@@ -1715,7 +1715,7 @@ addEpsInStats stats n_decls n_insts n_rules
, n_rules_in = n_rules_in stats + n_rules }
\end{code}
-Names in a NameCache are always stored as a Global, and have the SrcLoc
+Names in a NameCache are always stored as a Global, and have the SrcLoc
of their binding locations.
Actually that's not quite right. When we first encounter the original
@@ -1810,7 +1810,7 @@ ms_imps ms = ms_textual_imps ms ++ map mk_additional_import (dynFlagDependencies
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done. The point is that the summariser will have to cpp/unlit/whatever
--- all files anyway, and there's no point in doing this twice -- just
+-- all files anyway, and there's no point in doing this twice -- just
-- park the result in a temp file, put the name of it in the location,
-- and let @compile@ read from that file on the way back up.
@@ -1830,7 +1830,7 @@ instance Outputable ModSummary where
ppr ms
= sep [text "ModSummary {",
nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
- text "ms_mod =" <+> ppr (ms_mod ms)
+ text "ms_mod =" <+> ppr (ms_mod ms)
<> text (hscSourceString (ms_hsc_src ms)) <> comma,
text "ms_textual_imps =" <+> ppr (ms_textual_imps ms),
text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
@@ -1843,12 +1843,12 @@ showModMsg target recomp mod_summary
hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
char '(', text (normalise $ msHsFilePath mod_summary) <> comma,
case target of
- HscInterpreted | recomp
+ HscInterpreted | recomp
-> text "interpreted"
HscNothing -> text "nothing"
_ -> text (normalise $ msObjFilePath mod_summary),
char ')']
- where
+ where
mod = moduleName (ms_mod mod_summary)
mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
\end{code}
@@ -1887,11 +1887,11 @@ data SourceModified
\begin{code}
-- | Information about a modules use of Haskell Program Coverage
data HpcInfo
- = HpcInfo
+ = HpcInfo
{ hpcInfoTickCount :: Int
, hpcInfoHash :: Int
}
- | NoHpcInfo
+ | NoHpcInfo
{ hpcUsed :: AnyHpcUsage -- ^ Is hpc used anywhere on the module \*tree\*?
}
@@ -1900,7 +1900,7 @@ data HpcInfo
type AnyHpcUsage = Bool
emptyHpcInfo :: AnyHpcUsage -> HpcInfo
-emptyHpcInfo = NoHpcInfo
+emptyHpcInfo = NoHpcInfo
-- | Find out if HPC is used by this module or any of the modules
-- it depends upon
@@ -1931,7 +1931,7 @@ on just the OccName easily in a Core pass.
-- NB: The following tables may also include 'Var's, 'TyCon's and 'DataCon's from imported modules,
-- which have been subsequently vectorised in the current module.
--
-data VectInfo
+data VectInfo
= VectInfo
{ vectInfoVar :: VarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@
, vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@
@@ -1940,16 +1940,16 @@ data VectInfo
, vectInfoScalarTyCons :: NameSet -- ^ set of scalar type constructors
}
--- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
+-- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated
-- across module boundaries.
--
-data IfaceVectInfo
- = IfaceVectInfo
+data IfaceVectInfo
+ = IfaceVectInfo
{ ifaceVectInfoVar :: [Name] -- ^ All variables in here have a vectorised variant
, ifaceVectInfoTyCon :: [Name] -- ^ All 'TyCon's in here have a vectorised variant;
-- the name of the vectorised variant and those of its
-- data constructors are determined by
- -- 'OccName.mkVectTyConOcc' and
+ -- 'OccName.mkVectTyConOcc' and
-- 'OccName.mkVectDataConOcc'; the names of the
-- isomorphisms are determined by 'OccName.mkVectIsoOcc'
, ifaceVectInfoTyConReuse :: [Name] -- ^ The vectorised form of all the 'TyCon's in here
@@ -1960,11 +1960,11 @@ data IfaceVectInfo
}
noVectInfo :: VectInfo
-noVectInfo
+noVectInfo
= VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyVarSet emptyNameSet
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
-plusVectInfo vi1 vi2 =
+plusVectInfo vi1 vi2 =
VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
(vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
(vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
@@ -2143,7 +2143,7 @@ type BreakIndex = Int
data ModBreaks
= ModBreaks
{ modBreaks_flags :: BreakArray
- -- ^ The array of flags, one per breakpoint,
+ -- ^ The array of flags, one per breakpoint,
-- indicating which breakpoints are enabled.
, modBreaks_locs :: !(Array BreakIndex SrcSpan)
-- ^ An array giving the source span of each breakpoint.
@@ -2157,9 +2157,10 @@ data ModBreaks
emptyModBreaks :: ModBreaks
emptyModBreaks = ModBreaks
{ modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
- -- ToDo: can we avoid this?
+ -- ToDo: can we avoid this?
, modBreaks_locs = array (0,-1) []
, modBreaks_vars = array (0,-1) []
, modBreaks_decls = array (0,-1) []
}
\end{code}
+
diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs
index 700878aea6..a32991b97d 100644
--- a/compiler/utils/Bag.lhs
+++ b/compiler/utils/Bag.lhs
@@ -16,7 +16,7 @@ module Bag (
concatBag, foldBag, foldrBag, foldlBag,
isEmptyBag, isSingletonBag, consBag, snocBag, anyBag,
listToBag, bagToList,
- foldrBagM, foldlBagM, mapBagM, mapBagM_,
+ foldrBagM, foldlBagM, mapBagM, mapBagM_,
flatMapBagM, flatMapBagPairM,
mapAndUnzipBagM, mapAccumBagLM
) where
@@ -120,13 +120,13 @@ partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails)
where (sats, fails) = partition pred vs
-partitionBagWith :: (a -> Either b c) -> Bag a
+partitionBagWith :: (a -> Either b c) -> Bag a
-> (Bag b {- Left -},
Bag c {- Right -})
partitionBagWith _ EmptyBag = (EmptyBag, EmptyBag)
partitionBagWith pred (UnitBag val)
= case pred val of
- Left a -> (UnitBag a, EmptyBag)
+ Left a -> (UnitBag a, EmptyBag)
Right b -> (EmptyBag, UnitBag b)
partitionBagWith pred (TwoBags b1 b2)
= (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
@@ -269,3 +269,4 @@ instance Data a => Data (Bag a) where
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "Bag"
\end{code}
+
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 60fbe5b29a..5263081c9a 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -4,13 +4,6 @@
%
\begin{code}
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
-- | This module defines classes and functions for pretty-printing. It also
-- exports a number of helpful debugging and other utilities such as 'trace' and 'panic'.
--
@@ -18,74 +11,74 @@
-- module, except that it exports a number of additional functions that are rarely used,
-- and works over the 'SDoc' type.
module Outputable (
- -- * Type classes
- Outputable(..), OutputableBndr(..),
- PlatformOutputable(..),
+ -- * Type classes
+ Outputable(..), OutputableBndr(..),
+ PlatformOutputable(..),
-- * Pretty printing combinators
- SDoc, runSDoc, initSDocContext,
- docToSDoc,
- interppSP, interpp'SP, pprQuotedList, pprWithCommas, quotedListWithOr,
- empty, nest,
- char,
- text, ftext, ptext,
- int, integer, float, double, rational,
- parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets,
- semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
- lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
- blankLine,
- (<>), (<+>), hcat, hsep,
- ($$), ($+$), vcat,
- sep, cat,
- fsep, fcat,
- hang, punctuate, ppWhen, ppUnless,
- speakNth, speakNTimes, speakN, speakNOf, plural,
+ SDoc, runSDoc, initSDocContext,
+ docToSDoc,
+ interppSP, interpp'SP, pprQuotedList, pprWithCommas, quotedListWithOr,
+ empty, nest,
+ char,
+ text, ftext, ptext,
+ int, integer, float, double, rational,
+ parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets,
+ semi, comma, colon, dcolon, space, equals, dot, arrow, darrow,
+ lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
+ blankLine,
+ (<>), (<+>), hcat, hsep,
+ ($$), ($+$), vcat,
+ sep, cat,
+ fsep, fcat,
+ hang, punctuate, ppWhen, ppUnless,
+ speakNth, speakNTimes, speakN, speakNOf, plural,
coloured, PprColour, colType, colCoerc, colDataCon,
colBinder, bold, keyword,
-- * Converting 'SDoc' into strings and outputing it
- printSDoc, printErrs, printOutput, hPrintDump, printDump,
- printForC, printForAsm, printForUser, printForUserPartWay,
- pprCode, mkCodeStyle,
- showSDoc, showSDocOneLine,
+ printSDoc, printErrs, printOutput, hPrintDump, printDump,
+ printForC, printForAsm, printForUser, printForUserPartWay,
+ pprCode, mkCodeStyle,
+ showSDoc, showSDocOneLine,
showSDocForUser, showSDocDebug, showSDocDump, showSDocDumpOneLine,
showPpr,
- showSDocUnqual, showsPrecSDoc,
+ showSDocUnqual, showsPrecSDoc,
renderWithStyle,
- pprInfixVar, pprPrefixVar,
- pprHsChar, pprHsString, pprHsInfix, pprHsVar,
+ pprInfixVar, pprPrefixVar,
+ pprHsChar, pprHsString, pprHsInfix, pprHsVar,
pprFastFilePath,
-- * Controlling the style in which output is printed
- BindingSite(..),
+ BindingSite(..),
- PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
+ PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify, neverQualify,
QualifyName(..),
- getPprStyle, withPprStyle, withPprStyleDoc,
- pprDeeper, pprDeeperList, pprSetDepth,
- codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
- ifPprDebug, qualName, qualModule,
- mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
+ getPprStyle, withPprStyle, withPprStyleDoc,
+ pprDeeper, pprDeeperList, pprSetDepth,
+ codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
+ ifPprDebug, qualName, qualModule,
+ mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
mkUserStyle, cmdlineParserStyle, Depth(..),
-
- -- * Error handling and debugging utilities
- pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
- pprTrace, pprDefiniteTrace, warnPprTrace,
- trace, pgmError, panic, sorry, panicFastInt, assertPanic
+
+ -- * Error handling and debugging utilities
+ pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
+ pprTrace, pprDefiniteTrace, warnPprTrace,
+ trace, pgmError, panic, sorry, panicFastInt, assertPanic
) where
-import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
+import {-# SOURCE #-} Module( Module, ModuleName, moduleName )
import {-# SOURCE #-} Name( Name, nameModule )
import StaticFlags
-import FastString
+import FastString
import FastTypes
import Platform
import qualified Pretty
-import Util ( snocView )
-import Pretty ( Doc, Mode(..) )
+import Util ( snocView )
+import Pretty ( Doc, Mode(..) )
import Panic
import Data.Char
@@ -94,7 +87,7 @@ import qualified Data.IntMap as IM
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word
-import System.IO ( Handle, stderr, stdout, hFlush )
+import System.IO ( Handle, stderr, stdout, hFlush )
import System.FilePath
@@ -110,35 +103,35 @@ showMultiLineString s = [ showList s "" ]
%************************************************************************
-%* *
+%* *
\subsection{The @PprStyle@ data type}
-%* *
+%* *
%************************************************************************
\begin{code}
data PprStyle
= PprUser PrintUnqualified Depth
- -- Pretty-print in a way that will make sense to the
- -- ordinary user; must be very close to Haskell
- -- syntax, etc.
- -- Assumes printing tidied code: non-system names are
- -- printed without uniques.
+ -- Pretty-print in a way that will make sense to the
+ -- ordinary user; must be very close to Haskell
+ -- syntax, etc.
+ -- Assumes printing tidied code: non-system names are
+ -- printed without uniques.
| PprCode CodeStyle
- -- Print code; either C or assembler
+ -- Print code; either C or assembler
- | PprDump -- For -ddump-foo; less verbose than PprDebug.
- -- Does not assume tidied code: non-external names
- -- are printed with uniques.
+ | PprDump -- For -ddump-foo; less verbose than PprDebug.
+ -- Does not assume tidied code: non-external names
+ -- are printed with uniques.
- | PprDebug -- Full debugging output
+ | PprDebug -- Full debugging output
-data CodeStyle = CStyle -- The format of labels differs for C and assembler
- | AsmStyle
+data CodeStyle = CStyle -- The format of labels differs for C and assembler
+ | AsmStyle
data Depth = AllTheWay
- | PartWay Int -- 0 => stop
+ | PartWay Int -- 0 => stop
-- -----------------------------------------------------------------------------
@@ -161,7 +154,7 @@ type QueryQualifyName = Name -> QualifyName
data QualifyName -- given P:M.T
= NameUnqual -- refer to it as "T"
| NameQual ModuleName -- refer to it as "X.T" for the supplied X
- | NameNotInScope1
+ | NameNotInScope1
-- it is not in scope at all, but M.T is not bound in the current
-- scope, so we can refer to it as "M.T"
| NameNotInScope2
@@ -196,7 +189,7 @@ defaultUserStyle, defaultDumpStyle :: PprStyle
defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
defaultDumpStyle | opt_PprStyle_Debug = PprDebug
- | otherwise = PprDump
+ | otherwise = PprDump
-- | Style for printing error messages
mkErrStyle :: PrintUnqualified -> PprStyle
@@ -206,7 +199,7 @@ defaultErrStyle :: PprStyle
-- Default style for error messages
-- It's a bit of a hack because it doesn't take into account what's in scope
-- Only used for desugarer warnings, and typechecker errors in interface sigs
-defaultErrStyle
+defaultErrStyle
| opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay
| otherwise = mkUserStyle alwaysQualify (PartWay opt_PprUserLength)
@@ -228,9 +221,9 @@ The following test decides whether or not we are actually generating
code (either C or assembly), or generating interface files.
%************************************************************************
-%* *
+%* *
\subsection{The @SDoc@ data type}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -276,11 +269,12 @@ pprDeeperList f ds = SDoc work
work other_ctx = runSDoc (f ds) other_ctx
pprSetDepth :: Depth -> SDoc -> SDoc
-pprSetDepth depth doc = SDoc $ \ctx -> case ctx of
- SDC{sdocStyle=PprUser q _} ->
- runSDoc doc ctx{sdocStyle = PprUser q depth}
- _ ->
- runSDoc doc ctx
+pprSetDepth depth doc = SDoc $ \ctx ->
+ case ctx of
+ SDC{sdocStyle=PprUser q _} ->
+ runSDoc doc ctx{sdocStyle = PprUser q depth}
+ _ ->
+ runSDoc doc ctx
getPprStyle :: (PprStyle -> SDoc) -> SDoc
getPprStyle df = SDoc $ \ctx -> runSDoc (df (sdocStyle ctx)) ctx
@@ -296,8 +290,8 @@ qualModule (PprUser (_,qual_mod) _) m = qual_mod m
qualModule _other _m = True
codeStyle :: PprStyle -> Bool
-codeStyle (PprCode _) = True
-codeStyle _ = False
+codeStyle (PprCode _) = True
+codeStyle _ = False
asmStyle :: PprStyle -> Bool
asmStyle (PprCode AsmStyle) = True
@@ -308,17 +302,18 @@ dumpStyle PprDump = True
dumpStyle _other = False
debugStyle :: PprStyle -> Bool
-debugStyle PprDebug = True
-debugStyle _other = False
+debugStyle PprDebug = True
+debugStyle _other = False
userStyle :: PprStyle -> Bool
userStyle (PprUser _ _) = True
userStyle _other = False
-ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
-ifPprDebug d = SDoc $ \ctx -> case ctx of
- SDC{sdocStyle=PprDebug} -> runSDoc d ctx
- _ -> Pretty.empty
+ifPprDebug :: SDoc -> SDoc -- Empty for non-debug style
+ifPprDebug d = SDoc $ \ctx ->
+ case ctx of
+ SDC{sdocStyle=PprDebug} -> runSDoc d ctx
+ _ -> Pretty.empty
\end{code}
\begin{code}
@@ -350,7 +345,7 @@ hPrintDump h doc = do
better_doc = doc $$ blankLine
printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
-printForUser handle unqual doc
+printForUser handle unqual doc
= Pretty.printDoc PageMode handle
(runSDoc doc (initSDocContext (mkUserStyle unqual AllTheWay)))
@@ -465,7 +460,7 @@ cparen b d = SDoc $ Pretty.cparen b . runSDoc d
-- 'quotes' encloses something in single quotes...
-- but it omits them if the thing ends in a single quote
-- so that we don't get `foo''. Instead we just have foo'.
-quotes d = SDoc $ \sty ->
+quotes d = SDoc $ \sty ->
let pp_d = runSDoc d sty in
case snocView (show pp_d) of
Just (_, '\'') -> pp_d
@@ -499,7 +494,7 @@ nest :: Int -> SDoc -> SDoc
(<+>) :: SDoc -> SDoc -> SDoc
-- ^ Join two 'SDoc' together horizontally with a gap between them
($$) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together vertically; if there is
+-- ^ Join two 'SDoc' together vertically; if there is
-- no vertical overlap it "dovetails" the two onto one line
($+$) :: SDoc -> SDoc -> SDoc
-- ^ Join two 'SDoc' together vertically
@@ -546,9 +541,9 @@ punctuate :: SDoc -- ^ The punctuation
-> [SDoc] -- ^ Punctuated list
punctuate _ [] = []
punctuate p (d:ds) = go d ds
- where
- go d [] = [d]
- go d (e:es) = (d <> p) : go e es
+ where
+ go d [] = [d]
+ go d (e:es) = (d <> p) : go e es
ppWhen, ppUnless :: Bool -> SDoc -> SDoc
ppWhen True doc = doc
@@ -600,29 +595,29 @@ keyword = bold
%************************************************************************
-%* *
+%* *
\subsection[Outputable-class]{The @Outputable@ class}
-%* *
+%* *
%************************************************************************
\begin{code}
-- | Class designating that some type has an 'SDoc' representation
class Outputable a where
- ppr :: a -> SDoc
- pprPrec :: Rational -> a -> SDoc
- -- 0 binds least tightly
- -- We use Rational because there is always a
- -- Rational between any other two Rationals
+ ppr :: a -> SDoc
+ pprPrec :: Rational -> a -> SDoc
+ -- 0 binds least tightly
+ -- We use Rational because there is always a
+ -- Rational between any other two Rationals
- ppr = pprPrec 0
- pprPrec _ = ppr
+ ppr = pprPrec 0
+ pprPrec _ = ppr
class PlatformOutputable a where
- pprPlatform :: Platform -> a -> SDoc
- pprPlatformPrec :: Platform -> Rational -> a -> SDoc
-
- pprPlatform platform = pprPlatformPrec platform 0
- pprPlatformPrec platform _ = pprPlatform platform
+ pprPlatform :: Platform -> a -> SDoc
+ pprPlatformPrec :: Platform -> Rational -> a -> SDoc
+
+ pprPlatform platform = pprPlatformPrec platform 0
+ pprPlatformPrec platform _ = pprPlatform platform
\end{code}
\begin{code}
@@ -678,50 +673,50 @@ instance (Outputable a, Outputable b) => Outputable (Either a b) where
instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
ppr (x,y,z) =
parens (sep [ppr x <> comma,
- ppr y <> comma,
- ppr z ])
+ ppr y <> comma,
+ ppr z ])
instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
- Outputable (a, b, c, d) where
+ Outputable (a, b, c, d) where
ppr (a,b,c,d) =
parens (sep [ppr a <> comma,
- ppr b <> comma,
- ppr c <> comma,
- ppr d])
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e) =>
- Outputable (a, b, c, d, e) where
+ Outputable (a, b, c, d, e) where
ppr (a,b,c,d,e) =
parens (sep [ppr a <> comma,
- ppr b <> comma,
- ppr c <> comma,
- ppr d <> comma,
- ppr e])
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d <> comma,
+ ppr e])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f) =>
- Outputable (a, b, c, d, e, f) where
+ Outputable (a, b, c, d, e, f) where
ppr (a,b,c,d,e,f) =
parens (sep [ppr a <> comma,
- ppr b <> comma,
- ppr c <> comma,
- ppr d <> comma,
- ppr e <> comma,
- ppr f])
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d <> comma,
+ ppr e <> comma,
+ ppr f])
instance (Outputable a, Outputable b, Outputable c, Outputable d, Outputable e, Outputable f, Outputable g) =>
- Outputable (a, b, c, d, e, f, g) where
+ Outputable (a, b, c, d, e, f, g) where
ppr (a,b,c,d,e,f,g) =
parens (sep [ppr a <> comma,
- ppr b <> comma,
- ppr c <> comma,
- ppr d <> comma,
- ppr e <> comma,
- ppr f <> comma,
- ppr g])
+ ppr b <> comma,
+ ppr c <> comma,
+ ppr d <> comma,
+ ppr e <> comma,
+ ppr f <> comma,
+ ppr g])
instance Outputable FastString where
- ppr fs = ftext fs -- Prints an unadorned string,
- -- no double quotes or anything
+ ppr fs = ftext fs -- Prints an unadorned string,
+ -- no double quotes or anything
instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
ppr m = ppr (M.toList m)
@@ -732,9 +727,9 @@ instance (Outputable elt) => Outputable (IM.IntMap elt) where
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{The @OutputableBndr@ class}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -751,9 +746,9 @@ class Outputable a => OutputableBndr a where
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Random printing helpers}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -773,11 +768,11 @@ pprHsString fs = vcat (map text (showMultiLineString (unpackFS fs)))
pprPrefixVar :: Bool -> SDoc -> SDoc
pprPrefixVar is_operator pp_v
| is_operator = parens pp_v
- | otherwise = pp_v
+ | otherwise = pp_v
-- Put a name in backquotes if it's not an operator
pprInfixVar :: Bool -> SDoc -> SDoc
-pprInfixVar is_operator pp_v
+pprInfixVar is_operator pp_v
| is_operator = pp_v
| otherwise = char '`' <> pp_v <> char '`'
@@ -787,13 +782,13 @@ pprInfixVar is_operator pp_v
-- Reason: it means that pprHsVar doesn't need a NamedThing context,
-- which none of the HsSyn printing functions do
pprHsVar, pprHsInfix :: Outputable name => name -> SDoc
-pprHsVar v = pprPrefixVar (isOperator pp_v) pp_v
- where pp_v = ppr v
+pprHsVar v = pprPrefixVar (isOperator pp_v) pp_v
+ where pp_v = ppr v
pprHsInfix v = pprInfixVar (isOperator pp_v) pp_v
- where pp_v = ppr v
+ where pp_v = ppr v
isOperator :: SDoc -> Bool
-isOperator ppr_v
+isOperator ppr_v
= case showSDocUnqual ppr_v of
('(':_) -> False -- (), (,) etc
('[':_) -> False -- []
@@ -808,9 +803,9 @@ pprFastFilePath path = text $ normalise $ unpackFS path
\end{code}
%************************************************************************
-%* *
+%* *
\subsection{Other helper functions}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -845,9 +840,9 @@ quotedListWithOr xs = quotedList xs
%************************************************************************
-%* *
+%* *
\subsection{Printing numbers verbally}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -865,22 +860,22 @@ speakNth 5 = ptext (sLit "fifth")
speakNth 6 = ptext (sLit "sixth")
speakNth n = hcat [ int n, text suffix ]
where
- suffix | n <= 20 = "th" -- 11,12,13 are non-std
- | last_dig == 1 = "st"
- | last_dig == 2 = "nd"
- | last_dig == 3 = "rd"
- | otherwise = "th"
+ suffix | n <= 20 = "th" -- 11,12,13 are non-std
+ | last_dig == 1 = "st"
+ | last_dig == 2 = "nd"
+ | last_dig == 3 = "rd"
+ | otherwise = "th"
last_dig = n `rem` 10
-- | Converts an integer to a verbal multiplicity:
---
+--
-- > speakN 0 = text "none"
-- > speakN 5 = text "five"
-- > speakN 10 = text "10"
speakN :: Int -> SDoc
-speakN 0 = ptext (sLit "none") -- E.g. "he has none"
-speakN 1 = ptext (sLit "one") -- E.g. "he has one"
+speakN 0 = ptext (sLit "none") -- E.g. "he has none"
+speakN 1 = ptext (sLit "one") -- E.g. "he has one"
speakN 2 = ptext (sLit "two")
speakN 3 = ptext (sLit "three")
speakN 4 = ptext (sLit "four")
@@ -896,8 +891,8 @@ speakN n = int n
-- > speakNOf 3 (text "melon") = text "three melons"
speakNOf :: Int -> SDoc -> SDoc
speakNOf 0 d = ptext (sLit "no") <+> d <> char 's'
-speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument"
-speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
+speakNOf 1 d = ptext (sLit "one") <+> d -- E.g. "one argument"
+speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
-- | Converts a strictly positive integer into a number of times:
--
@@ -905,8 +900,8 @@ speakNOf n d = speakN n <+> d <> char 's' -- E.g. "three arguments"
-- > speakNTimes 2 = text "twice"
-- > speakNTimes 4 = text "4 times"
speakNTimes :: Int {- >=1 -} -> SDoc
-speakNTimes t | t == 1 = ptext (sLit "once")
- | t == 2 = ptext (sLit "twice")
+speakNTimes t | t == 1 = ptext (sLit "once")
+ | t == 2 = ptext (sLit "twice")
| otherwise = speakN t <+> ptext (sLit "times")
-- | Determines the pluralisation suffix appropriate for the length of a list:
@@ -921,9 +916,9 @@ plural _ = char 's'
%************************************************************************
-%* *
+%* *
\subsection{Error handling}
-%* *
+%* *
%************************************************************************
\begin{code}
@@ -972,10 +967,10 @@ assertPprPanic :: String -> Int -> SDoc -> a
assertPprPanic file line msg
= panic (show (runSDoc doc (initSDocContext PprDebug)))
where
- doc = sep [hsep[text "ASSERT failed! file",
- text file,
- text "line", int line],
- msg]
+ doc = sep [hsep[text "ASSERT failed! file",
+ text file,
+ text "line", int line],
+ msg]
warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
-- ^ Just warn about an assertion failure, recording the given file and line number.
@@ -986,5 +981,6 @@ warnPprTrace True file line msg x
= trace (show (runSDoc doc (initSDocContext defaultDumpStyle))) x
where
doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
- msg]
+ msg]
\end{code}
+
View Lorry Controller Status