Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Alex D
GHC
Commits
046ee54f
Commit
046ee54f
authored
Oct 11, 2006
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Module header tidyup #2
Push this further along, and fix build problems in the first patch.
parent
5199290f
Changes
38
Hide whitespace changes
Inline
Side-by-side
Showing
38 changed files
with
191 additions
and
201 deletions
+191
-201
compiler/HsVersions.h
compiler/HsVersions.h
+6
-0
compiler/main/DriverMkDepend.hs
compiler/main/DriverMkDepend.hs
+8
-8
compiler/main/DriverPipeline.hs
compiler/main/DriverPipeline.hs
+12
-11
compiler/main/DynFlags.hs
compiler/main/DynFlags.hs
+6
-6
compiler/main/ErrUtils.lhs
compiler/main/ErrUtils.lhs
+4
-3
compiler/main/Finder.lhs
compiler/main/Finder.lhs
+2
-3
compiler/main/HeaderInfo.hs
compiler/main/HeaderInfo.hs
+3
-3
compiler/main/Main.hs
compiler/main/Main.hs
+8
-7
compiler/main/Packages.lhs
compiler/main/Packages.lhs
+7
-10
compiler/main/ParsePkgConf.y
compiler/main/ParsePkgConf.y
+1
-1
compiler/main/StaticFlags.hs
compiler/main/StaticFlags.hs
+5
-5
compiler/main/SysTools.lhs
compiler/main/SysTools.lhs
+19
-25
compiler/nativeGen/AsmCodeGen.lhs
compiler/nativeGen/AsmCodeGen.lhs
+4
-4
compiler/nativeGen/MachCodeGen.hs
compiler/nativeGen/MachCodeGen.hs
+4
-4
compiler/nativeGen/MachInstrs.hs
compiler/nativeGen/MachInstrs.hs
+1
-1
compiler/nativeGen/PprMach.hs
compiler/nativeGen/PprMach.hs
+5
-10
compiler/nativeGen/RegisterAlloc.hs
compiler/nativeGen/RegisterAlloc.hs
+6
-6
compiler/parser/Ctype.lhs
compiler/parser/Ctype.lhs
+3
-3
compiler/parser/Lexer.x
compiler/parser/Lexer.x
+3
-3
compiler/parser/Parser.y.pp
compiler/parser/Parser.y.pp
+2
-2
compiler/utils/Bag.lhs
compiler/utils/Bag.lhs
+5
-2
compiler/utils/Binary.hs
compiler/utils/Binary.hs
+2
-2
compiler/utils/BufWrite.hs
compiler/utils/BufWrite.hs
+5
-5
compiler/utils/Digraph.lhs
compiler/utils/Digraph.lhs
+10
-8
compiler/utils/FastMutInt.lhs
compiler/utils/FastMutInt.lhs
+1
-6
compiler/utils/FastTypes.lhs
compiler/utils/FastTypes.lhs
+2
-2
compiler/utils/FiniteMap.lhs
compiler/utils/FiniteMap.lhs
+3
-3
compiler/utils/IOEnv.hs
compiler/utils/IOEnv.hs
+6
-4
compiler/utils/ListSetOps.lhs
compiler/utils/ListSetOps.lhs
+3
-1
compiler/utils/Maybes.lhs
compiler/utils/Maybes.lhs
+3
-4
compiler/utils/OrdList.lhs
compiler/utils/OrdList.lhs
+1
-0
compiler/utils/Outputable.lhs
compiler/utils/Outputable.lhs
+6
-7
compiler/utils/Panic.lhs
compiler/utils/Panic.lhs
+10
-19
compiler/utils/Pretty.lhs
compiler/utils/Pretty.lhs
+2
-4
compiler/utils/StringBuffer.lhs
compiler/utils/StringBuffer.lhs
+1
-1
compiler/utils/UniqFM.lhs
compiler/utils/UniqFM.lhs
+5
-3
compiler/utils/UniqSet.lhs
compiler/utils/UniqSet.lhs
+1
-0
compiler/utils/Util.lhs
compiler/utils/Util.lhs
+16
-15
No files found.
compiler/HsVersions.h
View file @
046ee54f
...
...
@@ -22,6 +22,12 @@ you will screw up the layout where they are used in case expressions!
* settings for the target plat instead). */
#include "../includes/ghcautoconf.h"
#if __GLASGOW_HASKELL__ >= 602
#define SYSTEM_IO_ERROR System.IO.Error
#else
#define SYSTEM_IO_ERROR System.IO
#endif
#ifdef __GLASGOW_HASKELL__
#define GLOBAL_VAR(name,value,ty) \
name = Util.global (value) :: IORef (ty); \
...
...
compiler/main/DriverMkDepend.hs
View file @
046ee54f
...
...
@@ -34,14 +34,14 @@ import Panic ( catchJust, ioErrors )
#
endif
import
ErrUtils
(
debugTraceMsg
,
printErrorsAndWarnings
)
import
D
ATA_
IOR
EF
(
IORef
,
readIORef
,
writeIORef
)
import
EXCEPTION
import
System
(
ExitCode
(
..
),
exitWith
)
import
Directory
import
IO
import
Monad
(
when
)
import
Maybe
(
isJust
)
import
D
ata.
IOR
ef
(
IORef
,
readIORef
,
writeIORef
)
import
Control.Exception
import
System.Exit
(
ExitCode
(
..
),
exitWith
)
import
System
.Directory
import
System.IO
import
SYSTEM_IO_ERROR
(
isEOFError
)
import
Control.Monad
(
when
)
import
Data.
Maybe
(
isJust
)
-----------------------------------------------------------------
--
...
...
compiler/main/DriverPipeline.hs
View file @
046ee54f
...
...
@@ -50,17 +50,18 @@ import ParserCoreUtils ( getCoreModuleName )
import
SrcLoc
(
unLoc
)
import
SrcLoc
(
Located
(
..
)
)
import
EXCEPTION
import
DATA_IOREF
(
readIORef
,
writeIORef
,
IORef
)
import
GLAEXTS
(
Int
(
..
)
)
import
Directory
import
System
import
IO
import
Monad
import
Control.Exception
as
Exception
import
Data.IORef
(
readIORef
,
writeIORef
,
IORef
)
import
GHC.Exts
(
Int
(
..
)
)
import
System.Directory
import
System.IO
import
SYSTEM_IO_ERROR
as
IO
import
Control.Monad
import
Data.List
(
isSuffixOf
)
import
Maybe
import
Data.Maybe
import
System.Exit
import
System.Cmd
import
System.Environment
-- ---------------------------------------------------------------------------
-- Pre-process
...
...
@@ -1133,7 +1134,7 @@ checkProcessArgsResult flags filename
getHCFilePackages
::
FilePath
->
IO
[
PackageId
]
getHCFilePackages
filename
=
E
XCEPTION
.
bracket
(
openFile
filename
ReadMode
)
hClose
$
\
h
->
do
E
xception
.
bracket
(
openFile
filename
ReadMode
)
hClose
$
\
h
->
do
l
<-
hGetLine
h
case
l
of
'/'
:
'*'
:
' '
:
'G'
:
'H'
:
'C'
:
'_'
:
'P'
:
'A'
:
'C'
:
'K'
:
'A'
:
'G'
:
'E'
:
'S'
:
rest
->
...
...
compiler/main/DynFlags.hs
View file @
046ee54f
...
...
@@ -69,20 +69,20 @@ import UniqFM ( UniqFM )
import
Util
(
notNull
,
splitLongestPrefix
,
normalisePath
)
import
Maybes
(
fromJust
,
orElse
)
import
SrcLoc
(
SrcSpan
)
import
Outputable
import
{-#
SOURCE
#-
}
ErrUtils
(
Severity
(
..
),
Message
,
mkLocMessage
)
import
D
ATA_
IOR
EF
(
readIORef
)
import
EXCEPTION
(
throwDyn
)
import
Monad
(
when
)
import
D
ata.
IOR
ef
(
readIORef
)
import
Control.Exception
(
throwDyn
)
import
Control.
Monad
(
when
)
#
ifdef
mingw32_TARGET_OS
import
Data.List
(
isPrefixOf
)
#
else
import
Util
(
split
)
#
endif
import
Char
(
isDigit
,
isUpper
)
import
Outputable
import
Data.Char
(
isDigit
,
isUpper
)
import
System.IO
(
hPutStrLn
,
stderr
)
import
{-#
SOURCE
#-
}
ErrUtils
(
Severity
(
..
),
Message
,
mkLocMessage
)
-- -----------------------------------------------------------------------------
-- DynFlags
...
...
compiler/main/ErrUtils.lhs
View file @
046ee54f
...
...
@@ -37,9 +37,10 @@ import qualified Pretty
import SrcLoc ( srcSpanStart, noSrcSpan )
import DynFlags ( DynFlags(..), DynFlag(..), dopt )
import StaticFlags ( opt_ErrorSpans )
import System ( ExitCode(..), exitWith )
import IO ( hPutStrLn, stderr )
import DYNAMIC
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( hPutStrLn, stderr )
import Data.Dynamic
-- -----------------------------------------------------------------------------
...
...
compiler/main/Finder.lhs
View file @
046ee54f
...
...
@@ -37,13 +37,12 @@ import FiniteMap
import UniqFM
import Maybes ( expectJust )
import DATA_IOREF ( IORef, writeIORef, readIORef, modifyIORef )
import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
import Data.List
import System.Directory
import System.IO
import Control.Monad
import Time
( ClockTime )
import
System.
Time ( ClockTime )
type FileExt = String -- Filename extension
...
...
compiler/main/HeaderInfo.hs
View file @
046ee54f
...
...
@@ -35,9 +35,9 @@ import Bag ( emptyBag, listToBag )
import
Distribution.Compiler
import
EXCEPTION
(
throwDyn
)
import
IO
import
List
import
Control.Exception
import
System.
IO
import
Data.
List
#
if
__GLASGOW_HASKELL__
>=
601
import
System.IO
(
openBinaryFile
)
...
...
compiler/main/Main.hs
View file @
046ee54f
...
...
@@ -41,13 +41,14 @@ import Util
import
Panic
-- Standard Haskell libraries
import
EXCEPTION
(
throwDyn
)
import
IO
import
Directory
(
doesDirectoryExist
)
import
System
(
getArgs
,
exitWith
,
ExitCode
(
..
)
)
import
Monad
import
List
import
Maybe
import
Control.Exception
(
throwDyn
)
import
System.IO
import
System.Directory
(
doesDirectoryExist
)
import
System.Environment
import
System.Exit
import
Control.Monad
import
Data.List
import
Data.Maybe
-----------------------------------------------------------------------------
-- ToDo:
...
...
compiler/main/Packages.lhs
View file @
046ee54f
...
...
@@ -42,15 +42,12 @@ import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
import Module
import UniqSet
import Util
import Maybes ( expectJust, MaybeErr(..) )
import Panic
import Outputable
#if __GLASGOW_HASKELL__ >= 603
import System.Directory ( getAppUserDataDirectory )
#else
#if __GLASGOW_HASKELL__ < 603
import Compat.Directory ( getAppUserDataDirectory )
#endif
...
...
@@ -58,15 +55,15 @@ import System.Environment ( getEnv )
import Distribution.InstalledPackageInfo
import Distribution.Package
import Distribution.Version
import System.Directory ( doesFileExist, doesDirectoryExist,
getDirectoryContents )
import Data.Maybe ( catMaybes )
import Control.Monad ( foldM )
import Data.List ( nub, partition, sortBy, isSuffixOf )
import FastString
import EXCEPTION ( throwDyn )
import ErrUtils ( debugTraceMsg, putMsg, Message )
import System.Directory
import Data.Maybe
import Control.Monad
import Data.List
import Control.Exception ( throwDyn )
-- ---------------------------------------------------------------------------
-- The Package state
...
...
compiler/main/ParsePkgConf.y
View file @
046ee54f
...
...
@@ -12,7 +12,7 @@ import ErrUtils ( mkLocMessage )
import SrcLoc
import Outputable
import Panic ( GhcException(..) )
import
EXCEPTION
( throwDyn )
import
Control.Exception
( throwDyn )
}
...
...
compiler/main/StaticFlags.hs
View file @
046ee54f
...
...
@@ -76,11 +76,11 @@ import Util
import
Maybes
(
firstJust
)
import
Panic
(
GhcException
(
..
),
ghcError
)
import
EXCEPTION
(
throwDyn
)
import
D
ATA_
IOR
EF
import
UNSAFE_IO
(
unsafePerformIO
)
import
Monad
(
when
)
import
Char
(
isDigit
)
import
Control.Exception
(
throwDyn
)
import
D
ata.
IOR
ef
import
System.IO.Unsafe
(
unsafePerformIO
)
import
Control.
Monad
(
when
)
import
Data.
Char
(
isDigit
)
import
Data.List
(
sort
,
intersperse
,
nub
)
-----------------------------------------------------------------------------
...
...
compiler/main/SysTools.lhs
View file @
046ee54f
...
...
@@ -37,31 +37,27 @@ module SysTools (
#include "HsVersions.h"
import DriverPhases
( isHaskellUserSrcFilename )
import DriverPhases
import Config
import Outputable
import ErrUtils ( putMsg, debugTraceMsg, showPass, Severity(..), Messages )
import Panic ( GhcException(..) )
import Util ( Suffix, global, notNull, consIORef, joinFileName,
normalisePath, pgmPath, platformPath, joinFileExt )
import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..),
setTmpDir, defaultDynFlags )
import EXCEPTION ( throwDyn, finally )
import DATA_IOREF ( IORef, readIORef, writeIORef )
import DATA_INT
import Monad ( when, unless )
import System ( ExitCode(..), getEnv, system )
import IO ( try, catch, hGetContents,
openFile, hPutStr, hClose, hFlush, IOMode(..),
stderr, ioError, isDoesNotExistError,
isAlreadyExistsError )
import Directory ( doesFileExist, removeFile,
createDirectory, removeDirectory )
import Maybe ( isJust )
import List ( partition )
import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, eltsFM )
import ErrUtils
import Panic
import Util
import DynFlags
import FiniteMap
import Control.Exception
import Data.IORef
import Data.Int
import Control.Monad
import System.Exit
import System.Cmd
import System.Environment
import System.IO
import SYSTEM_IO_ERROR as IO
import System.Directory
import Data.Maybe
import Data.List
-- GHC <= 4.08 didn't have rawSystem, and runs into problems with long command
-- lines on mingw32, so we disallow it now.
...
...
@@ -88,10 +84,8 @@ import Text.Regex
-- rawSystem comes from libghccompat.a in stage1
import Compat.RawSystem ( rawSystem )
import GHC.IOBase ( IOErrorType(..) )
import System.IO.Error ( ioeGetErrorType )
#else
import System.Process ( runInteractiveProcess, getProcessExitCode )
import System.IO ( hSetBuffering, hGetLine, BufferMode(..) )
import Control.Concurrent( forkIO, newChan, readChan, writeChan )
import Data.Char ( isSpace )
import FastString ( mkFastString )
...
...
compiler/nativeGen/AsmCodeGen.lhs
View file @
046ee54f
...
...
@@ -53,10 +53,10 @@ import FastString
import List ( intersperse )
#endif
import D
ATA_INT
import D
ATA_WORD
import D
ATA_BITS
import G
LAEXTS
import D
ata.Int
import D
ata.Word
import D
ata.Bits
import G
HC.Exts
{-
The native-code generator has machine-independent and
...
...
compiler/nativeGen/MachCodeGen.hs
View file @
046ee54f
...
...
@@ -42,13 +42,13 @@ import Constants ( wORD_SIZE )
#
ifdef
DEBUG
import
Outputable
(
assertPanic
)
import
TRACE
(
trace
)
import
Debug.Trace
(
trace
)
#
endif
import
Control.Monad
(
mapAndUnzipM
)
import
Maybe
(
fromJust
)
import
D
ATA_BITS
import
D
ATA_WORD
import
Data.
Maybe
(
fromJust
)
import
D
ata.Bits
import
D
ata.Word
-- -----------------------------------------------------------------------------
-- Top-level of the instruction selector
...
...
compiler/nativeGen/MachInstrs.hs
View file @
046ee54f
...
...
@@ -43,7 +43,7 @@ import Outputable
import
FastString
import
Constants
(
wORD_SIZE
)
import
G
LAEXTS
import
G
HC.Exts
-- -----------------------------------------------------------------------------
...
...
compiler/nativeGen/PprMach.hs
View file @
046ee54f
...
...
@@ -39,20 +39,15 @@ import qualified Outputable
import
StaticFlags
(
opt_PIC
,
opt_Static
)
#
if
__GLASGOW_HASKELL__
>=
504
import
Data.Array.ST
import
Data.Word
(
Word8
)
#
else
import
MutableArray
#
endif
import
MONAD_ST
import
Char
(
chr
,
ord
)
import
Maybe
(
isJust
)
import
Control.Monad.ST
import
Data.Char
(
chr
,
ord
)
import
Data.Maybe
(
isJust
)
#
if
powerpc_TARGET_ARCH
||
darwin_TARGET_OS
import
D
ATA_WORD
(
Word32
)
import
D
ATA_BITS
import
D
ata.Word
(
Word32
)
import
D
ata.Bits
#
endif
-- -----------------------------------------------------------------------------
...
...
compiler/nativeGen/RegisterAlloc.hs
View file @
046ee54f
...
...
@@ -100,13 +100,13 @@ import UniqSupply
import
Outputable
#
ifndef
DEBUG
import
Maybe
(
fromJust
)
import
Data.
Maybe
(
fromJust
)
#
endif
import
Maybe
(
fromMaybe
)
import
List
(
nub
,
partition
,
mapAccumL
,
groupBy
)
import
Monad
(
when
)
import
D
ATA_WORD
import
D
ATA_BITS
import
Data.
Maybe
(
fromMaybe
)
import
Data.
List
(
nub
,
partition
,
mapAccumL
,
groupBy
)
import
Control.
Monad
(
when
)
import
D
ata.Word
import
D
ata.Bits
-- -----------------------------------------------------------------------------
-- Some useful types
...
...
compiler/parser/Ctype.lhs
View file @
046ee54f
...
...
@@ -17,9 +17,9 @@ module Ctype
#include "HsVersions.h"
import D
ATA_INT
( Int32 )
import D
ATA_BITS
( Bits((.&.)) )
import Char
( ord, chr )
import D
ata.Int
( Int32 )
import D
ata.Bits
( Bits((.&.)) )
import
Data.
Char ( ord, chr )
\end{code}
Bit masks
...
...
compiler/parser/Lexer.x
View file @
046ee54f
...
...
@@ -43,10 +43,10 @@ import DynFlags
import Ctype
import Util ( maybePrefixMatch, readRational )
import D
ATA_BITS
import D
ata.Bits
import Data.Char ( chr, isSpace )
import Ratio
import
TRACE
import
Data.
Ratio
import
Debug.Trace
#if __GLASGOW_HASKELL__ >= 605
import Data.Char ( GeneralCategory(..), generalCategory, isPrint, isUpper )
...
...
compiler/parser/Parser.y.pp
View file @
046ee54f
...
...
@@ -42,10 +42,10 @@ import HaddockUtils
import
FastString
import
Maybes
(
orElse
)
import
Monad
(
when
)
import
Outputable
import
GLAEXTS
import
Control
.
Monad
(
when
)
import
GHC
.
Exts
import
Data
.
Char
import
Control
.
Monad
(
mplus
)
}
...
...
compiler/utils/Bag.lhs
View file @
046ee54f
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[Bags]{@Bag@: an unordered collection with duplicates}
Bag: an unordered collection with duplicates
\begin{code}
module Bag (
...
...
@@ -20,7 +22,8 @@ module Bag (
import Outputable
import Util ( isSingleton )
import List ( partition )
import Data.List ( partition )
\end{code}
...
...
compiler/utils/Binary.hs
View file @
046ee54f
{-# OPTIONS -cpp #-}
--
-- (c) The University of Glasgow 2002
-- (c) The University of Glasgow 2002
-2006
--
-- Binary I/O library, with special tweaks for GHC
--
...
...
@@ -59,7 +59,7 @@ import Unique
import
Panic
import
UniqFM
import
FastMutInt
import
PackageConfig
(
PackageId
,
packageIdFS
,
fsToPackageId
)
import
PackageConfig
import
Foreign
import
Data.Array.IO
...
...
compiler/utils/BufWrite.hs
View file @
046ee54f
...
...
@@ -2,7 +2,7 @@
--
-- Fast write-buffered Handles
--
-- (c) The University of Glasgow 2005
-- (c) The University of Glasgow 2005
-2006
--
-- This is a simple abstraction over Handles that offers very fast write
-- buffering, but without the thread safety that Handles provide. It's used
...
...
@@ -26,16 +26,16 @@ import FastString
import
FastMutInt
import
Panic
(
panic
)
import
Monad
(
when
)
import
Char
(
ord
)
import
Control.
Monad
(
when
)
import
Data.
Char
(
ord
)
import
Foreign
import
IO
import
System.
IO
import
GHC.IOBase
(
IO
(
..
)
)
import
System.IO
(
hPutBuf
)
import
GHC.Ptr
(
Ptr
(
..
)
)
import
G
LAEXTS
(
Int
(
..
),
Int
#
,
Addr
#
)
import
G
HC.Exts
(
Int
(
..
),
Int
#
,
Addr
#
)
-- -----------------------------------------------------------------------------
...
...
compiler/utils/Digraph.lhs
View file @
046ee54f
%
% (c) The University of Glasgow 2006
%
\begin{code}
module Digraph(
...
...
@@ -34,22 +38,20 @@ module Digraph(
import Util ( sortLe )
import Outputable
-- Extensions
import
MONAD_
ST
import
Control.Monad.
ST
-- std interfaces
import Maybe
import Array
import List
import Outputable
import Data.Maybe
import Data.Array
import Data.List
#if __GLASGOW_HASKELL__ > 604
import Data.Array.ST
#elif __GLASGOW_HASKELL__ >= 504
import Data.Array.ST hiding ( indices, bounds )
#else
import
ST
import
Data.Array.ST hiding ( indices, bounds )
#endif
\end{code}
...
...
compiler/utils/FastMutInt.lhs
View file @
046ee54f
{-# OPTIONS -cpp #-}
--
-- (c) The University of Glasgow 2002
-- (c) The University of Glasgow 2002
-2006
--
-- Unboxed mutable Ints
...
...
@@ -17,13 +17,8 @@ module FastMutInt(
#endif
#if __GLASGOW_HASKELL__ < 503
import GlaExts
import PrelIOBase
#else
import GHC.Base
import GHC.IOBase
#endif
#if __GLASGOW_HASKELL__ < 411
newByteArray# = newCharArray#
...
...
compiler/utils/FastTypes.lhs
View file @
046ee54f
%
% (c) The University of Glasgow, 2000
% (c) The University of Glasgow, 2000
-2006
%
\section{Fast integers and booleans}
...
...
@@ -17,7 +17,7 @@ module FastTypes (
#if defined(__GLASGOW_HASKELL__)
-- Import the beggars
import G
LAEXTS
import G
HC.Exts
( Int(..), Int#, (+#), (-#), (*#),
quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
)
...
...
compiler/utils/FiniteMap.lhs
View file @
046ee54f
%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[FiniteMap]{An implementation of finite maps}
``Finite maps'' are the heart of the compiler's
lookup-tables/environments and its implementation of sets. Important
...
...
@@ -62,7 +62,7 @@ import Bag ( Bag, foldrBag )
import Util
import Outputable
import G
LAEXTS
import G
HC.Exts
#if ! OMIT_NATIVE_CODEGEN
# define IF_NCG(a) a
...
...
compiler/utils/IOEnv.hs
View file @
046ee54f
-- (c) The University of Glasgow 2002
--
-- (c) The University of Glasgow 2002-2006
--
-- The IO Monad with an environment
--
...
...
@@ -26,9 +27,10 @@ module IOEnv (
#
include
"HsVersions.h"
import
Panic
(
try
,
tryUser
,
tryMost
,
Exception
(
..
)
)
import
DATA_IOREF
(
IORef
,
newIORef
,
readIORef
,
writeIORef
)
import
UNSAFE_IO
(
unsafeInterleaveIO
)
import
FIX_IO
(
fixIO
)
import
Data.IORef
(
IORef
,
newIORef
,
readIORef
,
writeIORef
)
import
System.IO.Unsafe
(
unsafeInterleaveIO
)
import
System.IO
(
fixIO
)
----------------------------------------------------------------------
...
...
compiler/utils/ListSetOps.lhs
View file @
046ee54f
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[ListSetOps]{Set-like operations on lists}
...
...
@@ -24,7 +25,8 @@ import Outputable
import Unique ( Unique )