- Fixes for bootstrapping with 3.01.
- Use 'official' extension interfaces rather than internal prelude
modules (such as ArrBase) where possible.
- Remove some cruft.
- Delete some unused imports found by '-fwarn-unused-imports'.
# define seqStrictlyST seqST
# define thenStrictlyST thenST
# define returnStrictlyST return
-# define _readHandle IOHandle.readHandle
-# define _writeHandle IOHandle.writeHandle
-# define _newHandle IOHandle.newdHandle
# define MkST ST
# if __GLASGOW_HASKELL__ >= 209
# define STATE_TOK(x) x
# define failWith fail
# define MkIOError(h,errt,msg) (IOError (Just h) errt msg)
# define CCALL_THEN thenIO_Prim
-# define _filePtr IOHandle.filePtr
# define Text Show
# define IMP_FASTSTRING() import FastString
# if __GLASGOW_HASKELL__ >= 209
#if defined(__GLASGOW_HASKELL__)
-- Import the beggars
-import GlaExts ( Int(..), Int#, (+#), (-#), (*#),
- quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
- )
+import GlaExts
+ ( Int(..), Int#, (+#), (-#), (*#),
+ quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
+ )
#define FAST_INT Int#
#define ILIT(x) (x#)
-- when compiling FastString itself
#ifndef COMPILING_FAST_STRING
--
-import FastString ( FastString, mkFastString, mkFastCharString#, nullFastString,
- consFS, headFS, tailFS, lengthFS, unpackFS, appendFS, concatFS
- )
+import qualified FastString
#endif
# define USE_FAST_STRINGS 1
-# define FAST_STRING FastString
-# define SLIT(x) (mkFastCharString# (x#))
-# define _NULL_ nullFastString
-# define _NIL_ (mkFastString "")
-# define _CONS_ consFS
-# define _HEAD_ headFS
-# define _TAIL_ tailFS
-# define _LENGTH_ lengthFS
-# define _PK_ mkFastString
-# define _UNPK_ unpackFS
-# define _APPEND_ `appendFS`
-# define _CONCAT_ concatFS
+# define FAST_STRING FastString.FastString
+# define SLIT(x) (FastString.mkFastCharString# (x#))
+# define _NULL_ FastString.nullFastString
+# define _NIL_ (FastString.mkFastString "")
+# define _CONS_ FastString.consFS
+# define _HEAD_ FastString.headFS
+# define _TAIL_ FastString.tailFS
+# define _LENGTH_ FastString.lengthFS
+# define _PK_ FastString.mkFastString
+# define _UNPK_ FastString.unpackFS
+# define _APPEND_ `FastString.appendFS`
+# define _CONCAT_ FastString.concatFS
#else
# define FAST_STRING String
# define SLIT(x) (x)
import IdInfo
import Maybes ( maybeToBool )
import Name ( nameUnique, mkLocalName, mkSysLocalName, isLocalName,
- mkCompoundName,
- isLocallyDefinedName, occNameString, modAndOcc,
- isLocallyDefined, changeUnique, isWiredInName,
- nameString, getOccString, setNameVisibility,
- isExported, ExportFlag(..), Provenance,
+ mkCompoundName, occNameString, modAndOcc,
+ changeUnique, isWiredInName, setNameVisibility,
+ ExportFlag(..), Provenance,
OccName(..), Name, Module,
NamedThing(..)
)
import PrimOp ( PrimOp )
import PrelMods ( pREL_TUP, pREL_BASE )
-import Lex ( mkTupNameStr )
import FieldLabel ( fieldLabelName, FieldLabel(..){-instances-} )
import PragmaInfo ( PragmaInfo(..) )
import SrcLoc ( mkBuiltinSrcLoc )
import TysWiredIn ( tupleTyCon )
import TyCon ( TyCon, tyConDataCons, isDataTyCon, isNewTyCon, mkSpecTyCon )
-import Type ( mkSigmaTy, mkTyVarTys, mkFunTys, splitSigmaTy,
+import Type ( mkSigmaTy, mkTyVarTys, mkFunTys,
mkTyConApp, instantiateTy, mkForAllTys,
tyVarsOfType, instantiateTy, typePrimRep,
instantiateTauTy,
)
import UniqFM
import UniqSet -- practically all of it
-import Unique ( getBuiltinUniques, pprUnique, Unique, Uniquable(..) )
+import Unique ( getBuiltinUniques, Unique, Uniquable(..) )
import Outputable
import SrcLoc ( SrcLoc )
-import Util ( mapAccumL, nOfThem, zipEqual, assoc )
+import Util ( nOfThem, assoc )
import GlaExts ( Int# )
\end{code}
import BasicTypes ( NewOrData )
import Demand
-import Maybes ( firstJust )
import Outputable
-import Unique ( pprUnique )
-import Util ( mapAccumL )
-ord = fromEnum :: Char -> Int
-showTypeCategory = panic "IdInfo.showTypeCategory"
+import Char ( ord )
\end{code}
An @IdInfo@ gives {\em optional} information about an @Id@. If
Text instance so that the update annotations can be read in.
\begin{code}
-#ifdef REALLY_HASKELL_1_3
instance Read UpdateInfo where
-#else
-instance Text UpdateInfo where
-#endif
readsPrec p s | null s = panic "IdInfo: empty update pragma?!"
| otherwise = [(SomeUpdateInfo (map ok_digit s),"")]
where
addArgUsageInfo id_info NoArgUsageInfo = id_info
addArgUsageInfo (IdInfo a b d e f g _ h) au_info = IdInfo a b d e f g au_info h
+{- UNUSED:
ppArgUsageInfo NoArgUsageInfo = empty
ppArgUsageInfo (SomeArgUsageInfo aut) = (<>) (ptext SLIT("_L_ ")) (ppArgUsageType aut)
+-}
ppArgUsage (ArgUsage n) = int n
ppArgUsage (UnknownArgUsage) = char '-'
#include "HsVersions.h"
import CoreSyn
-import CoreUnfold ( UnfoldingGuidance(..), Unfolding, mkUnfolding )
+import CoreUnfold ( Unfolding )
import Id ( mkPrimitiveId )
import IdInfo -- quite a few things
import StdIdInfo
import Name ( mkWiredInIdName, Name )
-import PrimOp ( primOpInfo, tagOf_PrimOp, primOp_str,
- PrimOpInfo(..), PrimOpResultInfo(..), PrimOp )
+import PrimOp ( primOpInfo, tagOf_PrimOp, PrimOpInfo(..), PrimOp )
import PrelMods ( pREL_GHC )
-import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyVarTy, mkTyConApp )
+import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp )
import TysWiredIn ( boolTy )
import Unique ( mkPrimOpIdUnique )
import Util ( panic )
import {-# SOURCE #-} Id ( Id )
import {-# SOURCE #-} TyCon ( TyCon )
-import CStrings ( identToC, modnameToC, cSEP )
+import CStrings ( identToC )
import CmdLineOpts ( opt_PprStyle_All, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import BasicTypes ( Module, IfaceFlavour(..), moduleString, pprModule )
-import Lex ( isLexSym, isLexConId )
+import Lex ( isLexConId )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
import Unique ( pprUnique, showUnique, Unique, Uniquable(..) )
import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList,
\begin{code}
modAndOcc :: NamedThing a => a -> (Module, OccName)
-getModule :: NamedThing a => a -> Module
getSrcLoc :: NamedThing a => a -> SrcLoc
isLocallyDefined :: NamedThing a => a -> Bool
isExported :: NamedThing a => a -> Bool
getOccString :: NamedThing a => a -> String
modAndOcc = nameModAndOcc . getName
-getModule = nameModule . getName
isExported = isExportedName . getName
getSrcLoc = nameSrcLoc . getName
isLocallyDefined = isLocallyDefinedName . getName
import Unique
import Util
-
import GlaExts
-import IOBase ( IO(..), IOResult(..) )
-import PrelBase ( Char(..) )
+
+#if __GLASGOW_HASKELL__ < 301
+import IOBase ( IO(..), IOResult(..) )
+#else
+#endif
w2i x = word2Int# x
i2w x = int2Word# x
foldlIdKey = mkPreludeMiscIdUnique 8
foldrIdKey = mkPreludeMiscIdUnique 9
forkIdKey = mkPreludeMiscIdUnique 10
-int2IntegerIdKey = mkPreludeMiscIdUnique 11
integerMinusOneIdKey = mkPreludeMiscIdUnique 12
integerPlusOneIdKey = mkPreludeMiscIdUnique 13
integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
#include "HsVersions.h"
-import CostCentre ( showCostCentre, CostCentre )
+import CostCentre ( CostCentre )
import Id ( idType, GenId{-instance Eq-}, Id )
import Type ( isUnboxedType,GenType, Type )
import TyVar ( GenTyVar, TyVar )
-import Util ( panic, assertPanic {-pprTrace:ToDo:rm-} )
+import Util ( panic, assertPanic )
import BinderInfo ( BinderInfo )
import BasicTypes ( Unused )
import Literal ( Literal )
\begin{code}
module CoreUnfold (
SimpleUnfolding(..), Unfolding(..), UnfoldingGuidance(..), -- types
- UfExpr, RdrName, -- For closure (delete in 1.3)
- FormSummary(..), mkFormSummary, whnfOrBottom, exprSmallEnoughToDup, exprIsTrivial,
+ FormSummary(..), mkFormSummary, whnfOrBottom, exprSmallEnoughToDup,
+ exprIsTrivial,
noUnfolding, mkMagicUnfolding, mkUnfolding, getUnfoldingTemplate,
- smallEnoughToInline, couldBeSmallEnoughToInline, certainlySmallEnoughToInline,
- inlineUnconditionally,
+ smallEnoughToInline, couldBeSmallEnoughToInline,
+ certainlySmallEnoughToInline, inlineUnconditionally,
calcUnfoldingGuidance,
import {-# SOURCE #-} MagicUFs ( MagicUnfoldingFun, mkMagicUnfoldingFun )
-import Bag ( emptyBag, unitBag, unionBags, Bag )
-
import CmdLineOpts ( opt_UnfoldingCreationThreshold,
opt_UnfoldingUseThreshold,
opt_UnfoldingConDiscount,
import PragmaInfo ( PragmaInfo(..) )
import CoreSyn
import CoreUtils ( unTagBinders )
-import HsCore ( UfExpr )
-import RdrHsSyn ( RdrName )
import OccurAnal ( occurAnalyseGlobalExpr )
import CoreUtils ( coreExprType )
import Id ( Id, idType, getIdArity, isBottomingId, isDataCon,
idWantsToBeINLINEd, idMustBeINLINEd, idMustNotBeINLINEd,
IdSet, GenId{-instances-} )
-import PrimOp ( primOpCanTriggerGC, fragilePrimOp, PrimOp(..) )
-import IdInfo ( ArityInfo(..), bottomIsGuaranteed )
-import Literal ( isNoRepLit, isLitLitLit )
+import PrimOp ( fragilePrimOp, primOpCanTriggerGC )
+import IdInfo ( ArityInfo(..) )
+import Literal ( isNoRepLit )
import TyCon ( tyConFamilySize )
import Type ( splitAlgTyConApp_maybe )
import Unique ( Unique )
-import UniqSet ( emptyUniqSet, unitUniqSet, mkUniqSet,
- addOneToUniqSet, unionUniqSets
- )
-import Maybes ( maybeToBool )
import Util ( isIn, panic, assertPanic )
import Outputable
\end{code}
addOneToIdEnv, growIdEnvList, lookupIdEnv,
isNullIdEnv, IdEnv, Id
)
-import Literal ( literalType, isNoRepLit, Literal(..) )
+import Literal ( literalType, Literal(..) )
import Maybes ( catMaybes, maybeToBool )
import PprCore
import PrimOp ( primOpType, PrimOp(..) )
import TysWiredIn ( trueDataCon, falseDataCon )
import Unique ( Unique )
import BasicTypes ( Unused )
-import UniqSupply ( initUs, returnUs, thenUs,
+import UniqSupply ( returnUs, thenUs,
mapUs, mapAndUnzipUs, getUnique,
UniqSM, UniqSupply
)
import CoreSyn
import CostCentre ( showCostCentre )
-import Id ( idType, getIdInfo, getIdStrictness, isTupleCon,
- nullIdEnv, DataCon, GenId{-instances-},
- Id
+import Id ( idType, getIdInfo, isTupleCon,
+ DataCon, GenId{-instances-}, Id
)
import IdInfo ( ppIdInfo, ppStrictnessInfo )
import Literal ( Literal{-instances-} )
-import Name ( OccName )
import Outputable -- quite a few things
import PprEnv
import PprType ( pprParendGenType, pprTyVarBndr, GenType{-instances-}, GenTyVar{-instance-} )
import {-# SOURCE #-} HsMatches ( pprMatches, Match, pprGRHSsAndBinds, GRHSsAndBinds )
-- friends:
-import HsPragmas ( GenPragmas, ClassOpPragmas )
import HsTypes ( HsType )
import CoreSyn ( CoreExpr )
import PprCore () -- Instances for Outputable
--others:
-import Id ( DictVar, Id, GenId )
+import Id ( Id, GenId )
import Name ( OccName, NamedThing(..) )
import BasicTypes ( RecFlag(..) )
import Outputable
-- friends:
import HsTypes ( HsType, pprParendHsType )
-import PrimOp ( PrimOp, tagOf_PrimOp )
import Kind ( Kind {- instance Outputable -} )
-import Type ( GenType {- instance Outputable -} )
-- others:
import Literal ( Literal )
-- friends:
import HsBinds ( HsBinds, MonoBinds, Sig, nullMonoBinds )
-import HsPragmas ( DataPragmas, ClassPragmas,
- InstancePragmas, ClassOpPragmas
- )
+import HsPragmas ( DataPragmas, ClassPragmas )
import HsTypes
import HsCore ( UfExpr )
import BasicTypes ( Fixity, NewOrData(..) )
brackets (interpp'SP dicts),
brackets (interpp'SP methods)])
-pprConPatTy ty
- = parens (ppr ty)
\end{code}
%************************************************************************
#include "HsVersions.h"
--- friends:
-import HsTypes ( HsType )
-
--- others:
import IdInfo
import Outputable
\end{code}
instance Outputable name => Outputable (GenPragmas name) where
ppr NoGenPragmas = empty
\end{code}
-
-========================= OLD CODE SCEDULED FOR DELETION SLPJ Nov 96 ==============
-
-\begin{code}
-{- COMMENTED OUT
-
-Certain pragmas expect to be pinned onto certain constructs.
-
-Pragma types may be parameterised, just as with any other
-abstract-syntax type.
-
-For a @data@ declaration---indicates which specialisations exist.
-\begin{code}
-data DataPragmas name
- = NoDataPragmas
- | DataPragmas [[Maybe (HsType name)]] -- types to which specialised
-
-noDataPragmas = NoDataPragmas
-isNoDataPragmas NoDataPragmas = True
-\end{code}
-
-These are {\em general} things you can know about any value:
-\begin{code}
-data GenPragmas name
- = NoGenPragmas
- | GenPragmas (Maybe Int) -- arity (maybe)
- (Maybe UpdateInfo) -- update info (maybe)
- (ImpStrictness name) -- strictness, worker-wrapper
- (ImpUnfolding name) -- unfolding (maybe)
- [([Maybe (HsType name)], -- Specialisations: types to which spec'd;
- Int, -- # dicts to ignore
- GenPragmas name)] -- Gen info about the spec'd version
-
-noGenPragmas = NoGenPragmas
-
-isNoGenPragmas NoGenPragmas = True
-isNoGenPragmas _ = False
-
-data ImpUnfolding name
- = NoImpUnfolding
- | ImpMagicUnfolding FAST_STRING -- magic "unfolding"
- -- known to the compiler by "String"
- | ImpUnfolding UnfoldingGuidance -- always, if you like, etc.
- (UnfoldingCoreExpr name)
-
-data ImpStrictness name
- = NoImpStrictness
- | ImpStrictness Bool -- True <=> bottoming Id
- [Demand] -- demand info
- (GenPragmas name) -- about the *worker*
-\end{code}
-
-For an ordinary imported function: it can have general pragmas (only).
-
-For a class's super-class dictionary selectors:
-\begin{code}
-data ClassPragmas name
- = NoClassPragmas
- | SuperDictPragmas [GenPragmas name] -- list mustn't be empty
-
-noClassPragmas = NoClassPragmas
-
-isNoClassPragmas NoClassPragmas = True
-isNoClassPragmas _ = False
-\end{code}
-
-For a class's method selectors:
-\begin{code}
-data ClassOpPragmas name
- = NoClassOpPragmas
- | ClassOpPragmas (GenPragmas name) -- for method selector
- (GenPragmas name) -- for default method
-
-
-noClassOpPragmas = NoClassOpPragmas
-
-isNoClassOpPragmas NoClassOpPragmas = True
-isNoClassOpPragmas _ = False
-\end{code}
-
-\begin{code}
-data InstancePragmas name
- = NoInstancePragmas
-
- | SimpleInstancePragma -- nothing but for the dfun itself...
- (GenPragmas name)
-
- | ConstantInstancePragma
- (GenPragmas name) -- for the "dfun" itself
- [(name, GenPragmas name)] -- one per class op
-
- | SpecialisedInstancePragma
- (GenPragmas name) -- for its "dfun"
- [([Maybe (HsType name)], -- specialised instance; type...
- Int, -- #dicts to ignore
- InstancePragmas name)] -- (no SpecialisedInstancePragma please!)
-
-noInstancePragmas = NoInstancePragmas
-
-isNoInstancePragmas NoInstancePragmas = True
-isNoInstancePragmas _ = False
-\end{code}
-
-Some instances for printing (just for debugging, really)
-\begin{code}
-instance Outputable name => Outputable (ClassPragmas name) where
- ppr NoClassPragmas = empty
- ppr (SuperDictPragmas sdsel_prags)
- = ($$) (ptext SLIT("{-superdict pragmas-}"))
- (ppr sdsel_prags)
-
-instance Outputable name => Outputable (ClassOpPragmas name) where
- ppr NoClassOpPragmas = empty
- ppr (ClassOpPragmas op_prags defm_prags)
- = ($$) (hsep [ptext SLIT("{-meth-}"), ppr op_prags])
- (hsep [ptext SLIT("{-defm-}"), ppr defm_prags])
-
-instance Outputable name => Outputable (InstancePragmas name) where
- ppr NoInstancePragmas = empty
- ppr (SimpleInstancePragma dfun_pragmas)
- = hsep [ptext SLIT("{-dfun-}"), ppr dfun_pragmas]
- ppr (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
- = ($$) (hsep [ptext SLIT("{-constm-}"), ppr dfun_pragmas])
- (vcat (map pp_pair name_pragma_pairs))
- where
- pp_pair (n, prags)
- = hsep [ppr n, equals, ppr prags]
-
- ppr (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
- = ($$) (hsep [ptext SLIT("{-spec'd-}"), ppr dfun_pragmas])
- (vcat (map pp_info spec_pragma_info))
- where
- pp_info (ty_maybes, num_dicts, prags)
- = hcat [brackets (hsep (map pp_ty ty_maybes)),
- parens (int num_dicts), equals, ppr prags]
- pp_ty Nothing = ptext SLIT("_N_")
- pp_ty (Just t)= ppr t
-
-instance Outputable name => Outputable (GenPragmas name) where
- ppr NoGenPragmas = empty
- ppr (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
- = hsep [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
- pp_str strictness, pp_unf unfolding,
- pp_specs specs]
- where
- pp_arity Nothing = empty
- pp_arity (Just i) = (<>) (ptext SLIT("ARITY=")) (int i)
-
- pp_upd Nothing = empty
- pp_upd (Just u) = ppUpdateInfo u
-
- pp_str NoImpStrictness = empty
- pp_str (ImpStrictness is_bot demands wrkr_prags)
- = hcat [ptext SLIT("IS_BOT="), ppr is_bot,
- ptext SLIT("STRICTNESS="), text (showList demands ""),
- ptext SLIT(" {"), ppr wrkr_prags, char '}']
-
- pp_unf NoImpUnfolding = ptext SLIT("NO_UNFOLDING")
- pp_unf (ImpMagicUnfolding m) = (<>) (ptext SLIT("MAGIC=")) (ptext m)
- pp_unf (ImpUnfolding g core) = (<>) (ptext SLIT("UNFOLD=")) (ppr core)
-
- pp_specs [] = empty
- pp_specs specs
- = hcat [ptext SLIT("SPECS=["), hsep (map pp_spec specs), char ']']
- where
- pp_spec (ty_maybes, num_dicts, gprags)
- = hsep [brackets (hsep (map pp_MaB ty_maybes)), int num_dicts, ppr gprags]
-
- pp_MaB Nothing = ptext SLIT("_N_")
- pp_MaB (Just x) = ppr x
-\end{code}
-
-
-\begin{code}
--}
-\end{code}
import Outputable
import Kind ( Kind {- instance Outputable -} )
-import Name ( nameOccName )
-import Util ( thenCmp, cmpList, isIn, panic )
+import Util ( thenCmp, cmpList, panic )
import GlaExts ( Int#, (<#) )
\end{code}
import Array ( array, (//) )
import GlaExts
-import ArrBase
import Argv
import Constants -- Default values for some flags
import Maybes ( assocMaybe, firstJust, maybeToBool )
-import Util ( startsWith, panic, panic#, assertPanic )
+import Util ( startsWith, panic, panic# )
+
+#if __GLASGOW_HASKELL__ < 301
+import ArrBase ( Array(..) )
+#else
+import PrelArr ( Array(..) )
+#endif
\end{code}
A command-line {\em switch} is (generally) either on or off; e.g., the
SwBool False -> False
_ -> True
-stringSwitchSet :: (switch -> SwitchResult)
- -> (FAST_STRING -> switch)
- -> Maybe FAST_STRING
-
-stringSwitchSet lookup_fn switch
- = case (lookup_fn (switch (panic "stringSwitchSet"))) of
- SwString str -> Just str
- _ -> Nothing
-
intSwitchSet :: (switch -> SwitchResult)
-> (Int -> switch)
-> Maybe Int
import GlaExts
import Name
-import RdrHsSyn ( RdrName(..) )
-import BasicTypes ( IfaceFlavour )
import SrcLoc ( mkSrcLoc, noSrcLoc, SrcLoc )
import FastString ( FastString, mkFastCharString, mkFastCharString2 )
\end{code}
, voidTyCon
, wordTyCon
]
-
-min_nonprim_tycon_list -- used w/ HideMostBuiltinNames
- = [ boolTyCon
- , charTyCon
- , intTyCon
- , floatTyCon
- , doubleTyCon
- , integerTyCon
- , liftTyCon
- , return2GMPsTyCon -- ADR asked for these last two (WDP 94/11)
- , returnIntAndGMPTyCon
- ]
\end{code}
%************************************************************************
#include "HsVersions.h"
-import {-# SOURCE #-} CoreUnfold ( UnfoldingGuidance(..), mkUnfolding )
+import {-# SOURCE #-} CoreUnfold ( mkUnfolding )
-import Id ( Id, mkImported, mkTemplateLocals )
+import Id ( Id, mkImported )
import SpecEnv ( SpecEnv, emptySpecEnv )
-- friends:
import TysWiredIn
-- others:
-import CmdLineOpts ( maybe_CompilingGhcInternals )
import CoreSyn -- quite a bit
import IdInfo -- quite a bit
-import Literal ( mkMachInt )
import Name ( mkWiredInIdName, Module )
import PragmaInfo
-import PrimOp ( PrimOp(..) )
import Type
-import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar, TyVar )
+import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, TyVar )
import Unique -- lots of *Keys
import Util ( panic )
\end{code}
)
import IdInfo ( ArityInfo, exactArity )
import Class ( classBigSig, classTyCon )
-import TyCon ( isNewTyCon, isDataTyCon, isAlgTyCon, tyConDataCons )
+import TyCon ( isNewTyCon, tyConDataCons )
import FieldLabel ( FieldLabel )
import PrelVals ( pAT_ERROR_ID )
import Maybes
#include "HsVersions.h"
-import Kind ( mkUnboxedTypeKind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
+import Kind ( mkBoxedTypeKind )
import Name ( mkWiredInTyConName )
import PrimRep ( PrimRep(..) ) -- getPrimRepInfo uses PrimRep repn
import TyCon ( mkPrimTyCon, mkDataTyCon, TyCon )
#include "HsVersions.h"
-import Id ( externallyVisibleId, GenId, showId, Id )
+import Id ( externallyVisibleId, GenId, Id )
import CStrings ( identToC, stringToC )
-import Name ( OccName, getOccString, moduleString, nameString )
+import Name ( OccName, getOccString, moduleString )
import Outputable
import Util ( panic, panic#, assertPanic, thenCmp )
where
cc_IS_CAF = "CC_IS_CAF"
cc_IS_DICT = "CC_IS_DICT"
- cc_IS_SUBSUMED = "CC_IS_SUBSUMED"
cc_IS_BORING = "CC_IS_BORING"
do_caf IsCafCC = cc_IS_CAF
#include "HsVersions.h"
-import Char (isDigit, isAlpha, isAlphanum, isUpper,isLower, isSpace, ord )
+import Char (isDigit, isAlphanum, isUpper,isLower, isSpace, ord )
import {-# SOURCE #-} CostCentre
import HsSyn
import Lex
-import PrelMods ( pRELUDE )
-import BasicTypes ( Module(..), NewOrData, IfaceFlavour(..), Unused )
-import Name ( ExportFlag(..), pprModule,
- OccName(..), pprOccName,
+import BasicTypes ( Module(..), IfaceFlavour(..), Unused )
+import Name ( pprModule, OccName(..), pprOccName,
prefixOccName, NamedThing )
import Util ( thenCmp )
-import CoreSyn ( GenCoreExpr )
import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
import List ( nub )
import Outputable
#include "HsVersions.h"
import HsSyn
-import RdrHsSyn ( RdrName(..), RdrNameHsModule, RdrNameImportDecl )
+import RdrHsSyn ( RdrName(..), RdrNameHsModule )
import RnHsSyn ( RenamedHsModule, RenamedHsDecl, extractHsTyNames )
-import CmdLineOpts ( opt_HiMap, opt_WarnNameShadowing, opt_D_show_rn_trace,
+import CmdLineOpts ( opt_HiMap, opt_D_show_rn_trace,
opt_D_dump_rn, opt_D_show_rn_stats,
opt_WarnUnusedBinds, opt_WarnUnusedImports
)
getDeferredDataDecls,
mkSearchPath, getSlurpedNames, getRnStats
)
-import RnEnv ( availsToNameSet, addAvailToNameSet,
- addImplicitOccsRn, lookupImplicitOccRn )
-import Name ( Name, PrintUnqualified, Provenance, ExportFlag(..),
- isLocallyDefined,
- NameSet(..), elemNameSet, mkNameSet, unionNameSets,
+import RnEnv ( addImplicitOccsRn )
+import Name ( Name, PrintUnqualified, Provenance, isLocallyDefined,
+ NameSet(..),
nameSetToList, minusNameSet, NamedThing(..),
nameModule, pprModule, pprOccName, nameOccName
)
import ErrUtils ( pprBagOfErrors, pprBagOfWarnings,
doIfSet, dumpIfSet, ghcExit
)
-import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
import Bag ( isEmptyBag )
import UniqSupply ( UniqSupply )
import Util ( equivClasses )
import {-# SOURCE #-} RnSource ( rnHsSigType )
import HsSyn
-import HsPragmas ( isNoGenPragmas, noGenPragmas )
import RdrHsSyn
import RnHsSyn
import RnMonad
minusNameSet, unionManyNameSets, elemNameSet, unitNameSet, nameSetToList
)
import BasicTypes ( RecFlag(..), TopLevelFlag(..) )
-import Maybes ( catMaybes )
-import Util ( thenCmp, isIn, removeDups, panic, panic#, assertPanic, assocDefault )
+import Util ( thenCmp, removeDups, panic, panic#, assertPanic )
import UniqSet ( UniqSet )
import ListSetOps ( minusList )
import Bag ( bagToList )
opt_WarnUnusedBinds, opt_WarnUnusedImports )
import HsSyn
import RdrHsSyn ( RdrName(..), RdrNameIE,
- rdrNameOcc, ieOcc, isQual, qual
+ rdrNameOcc, isQual, qual
)
import HsTypes ( getTyVarName, replaceTyVarName )
-import BasicTypes ( Fixity(..), FixityDirection(..), IfaceFlavour(..), pprModule )
+import BasicTypes ( Fixity(..), FixityDirection(..), IfaceFlavour(..) )
import RnMonad
import Name ( Name, OccName(..), Provenance(..), ExportFlag(..), NamedThing(..),
- occNameString, occNameFlavour, getSrcLoc,
+ occNameFlavour, getSrcLoc,
NameSet, emptyNameSet, addListToNameSet, nameSetToList,
mkLocalName, mkGlobalName, modAndOcc,
nameOccName, setNameProvenance, isVarOcc, getNameProvenance,
- pprProvenance, pprOccName, pprModule, pprNameProvenance,
- isLocalName
+ pprOccName, isLocalName
)
import TyCon ( TyCon )
-import TysWiredIn ( tupleTyCon, listTyCon, charTyCon, intTyCon )
+import TysWiredIn ( tupleTyCon, listTyCon, charTyCon )
import FiniteMap
import Unique ( Unique, Uniquable(..), unboundKey )
import UniqFM ( listToUFM, plusUFM_C )
-import Maybes ( maybeToBool )
import UniqSupply
import SrcLoc ( SrcLoc, noSrcLoc )
import Outputable
floatPrimTyCon, doublePrimTyCon
)
import Name
-import UniqFM ( lookupUFM, {- ToDo:rm-} isNullUFM )
-import UniqSet ( emptyUniqSet, unitUniqSet,
- unionUniqSets, unionManyUniqSets,
- UniqSet
- )
+import UniqFM ( isNullUFM )
+import UniqSet ( emptyUniqSet, unionManyUniqSets, UniqSet )
import Util ( removeDups )
import Outputable
\end{code}
HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
hsDeclName
)
-import HsPragmas ( noGenPragmas )
import BasicTypes ( Version, NewOrData(..), IfaceFlavour(..) )
import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyDecl,
RdrName(..), rdrNameOcc
)
-import RnEnv ( newImportedGlobalName, addImplicitOccsRn, ifaceFlavour,
- availName, availNames, addAvailToNameSet, pprAvail
+import RnEnv ( newImportedGlobalName, addImplicitOccsRn,
+ ifaceFlavour, availName, availNames, addAvailToNameSet
)
import RnSource ( rnHsSigType )
import RnMonad
import RnHsSyn ( RenamedHsDecl )
import ParseIface ( parseIface, IfaceStuff(..) )
-import FiniteMap ( FiniteMap, sizeFM, emptyFM, unitFM, delFromFM,
+import FiniteMap ( FiniteMap, sizeFM, emptyFM, delFromFM,
lookupFM, addToFM, addToFM_C, addListToFM,
- fmToList, eltsFM
+ fmToList
)
import Name ( Name {-instance NamedThing-}, Provenance, OccName(..),
- nameModule, occNameString, moduleString, pprModule, isLocallyDefined,
+ nameModule, moduleString, pprModule, isLocallyDefined,
NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
minusNameSet, mkNameSet, elemNameSet, nameUnique, addOneToNameSet,
isWiredInName, maybeWiredInTyConName, maybeWiredInIdName,
import PrelMods ( pREL_GHC )
import PrelInfo ( cCallishTyKeys )
import Bag
-import Maybes ( MaybeErr(..), expectJust, maybeToBool )
+import Maybes ( MaybeErr(..), maybeToBool )
import ListSetOps ( unionLists )
import Outputable
import Unique ( Unique )
-import StringBuffer ( StringBuffer, hGetStringBuffer, freeStringBuffer )
+import StringBuffer ( StringBuffer, hGetStringBuffer )
import FastString ( mkFastString )
import Outputable
RdrNameHsModule, RdrNameFixityDecl,
rdrNameOcc, ieOcc
)
-import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
import RnIfaces ( getInterfaceExports, getDeclBinders, recordSlurp, checkUpToDate )
import BasicTypes ( IfaceFlavour(..) )
import RnEnv
import FiniteMap
import PrelMods
-import UniqFM ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
+import UniqFM ( UniqFM, addListToUFM_C, lookupUFM )
import Bag ( Bag, bagToList )
-import Maybes ( maybeToBool, expectJust )
+import Maybes ( maybeToBool )
import Name
import Outputable
import Util ( removeDups )
listType_RDR, tupleType_RDR )
import RnMonad
-import Name ( Name, isLocallyDefined,
- OccName(..), occNameString, prefixOccName,
- ExportFlag(..),
- Provenance(..), getNameProvenance,
- NameSet, unionNameSets, emptyNameSet, mkNameSet, unitNameSet,
- elemNameSet, nameSetToList
+import Name ( Name, OccName(..), occNameString, prefixOccName,
+ ExportFlag(..), Provenance(..), NameSet,
+ elemNameSet
)
-import FiniteMap ( emptyFM, lookupFM, addListToFM_C )
+import FiniteMap ( lookupFM )
import Id ( GenId{-instance NamedThing-} )
-import IdInfo ( IdInfo, StrictnessInfo(..), FBTypeInfo, DemandInfo, ArgUsageInfo )
+import IdInfo ( FBTypeInfo, ArgUsageInfo )
import Lex ( isLexCon )
-import CoreUnfold ( Unfolding(..), SimpleUnfolding )
-import MagicUFs ( MagicUnfoldingFun )
import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NAME )
-import ListSetOps ( unionLists, minusList )
-import Maybes ( maybeToBool, catMaybes )
-import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList )
+import Maybes ( maybeToBool )
+import Bag ( bagToList )
import Outputable
import SrcLoc ( SrcLoc )
import Unique ( Unique )
import BinderInfo
import CmdLineOpts ( opt_D_dump_occur_anal, SimplifierSwitch(..) )
import CoreSyn
-import Digraph ( stronglyConnComp, stronglyConnCompR, SCC(..) )
+import Digraph ( stronglyConnCompR, SCC(..) )
import Id ( idWantsToBeINLINEd, addNoInlinePragma, nukeNoInlinePragma,
idType, idUnique, Id,
emptyIdSet, unionIdSets, mkIdSet,
- unitIdSet, elementOfIdSet,
+ elementOfIdSet,
addOneToIdSet, IdSet,
nullIdEnv, unitIdEnv, combineIdEnvs,
delOneFromIdEnv, delManyFromIdEnv, isNullIdEnv,
import TyVar ( GenTyVar{-instance Eq-} )
import Unique ( Unique{-instance Eq-}, u2i )
import UniqFM ( keysUFM )
-import Util ( assoc, zipEqual, zipWithEqual )
+import Util ( zipWithEqual )
import Outputable
-import List ( partition )
isSpecPragmaId_maybe x = Nothing -- ToDo:!trace "OccurAnal.isSpecPragmaId_maybe"
\end{code}
keepUnusedBinding (OccEnv keep_dead keep_spec keep_conjurable _ _ _) binder
= keep_dead || (keep_spec && maybeToBool (isSpecPragmaId_maybe binder))
+{- UNUSED:
keepBecauseConjurable :: OccEnv -> Id -> Bool
keepBecauseConjurable (OccEnv _ _ keep_conjurable _ _ _) binder
= False
{- keep_conjurable && isConstMethodId binder -}
+-}
type UsageDetails = IdEnv BinderInfo -- A finite map from ids to their usage
occAnalBind env (Rec pairs) body_usage
= foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs
where
- pp_scc (CyclicSCC cycle) = hcat [text "Cyclic ", hcat (punctuate comma (map pp_item cycle))]
- pp_scc (AcyclicSCC item) = hcat [text "Acyclic ", pp_item item]
pp_item (_, bndr, _) = ppr bndr
binders = map fst pairs
)
import CoreSyn
import CoreUnfold ( mkFormSummary, couldBeSmallEnoughToInline, whnfOrBottom,
- Unfolding(..), UfExpr, RdrName,
- SimpleUnfolding(..), FormSummary(..),
- calcUnfoldingGuidance, UnfoldingGuidance(..)
- )
-import CoreUtils ( coreExprCc, unTagBinders )
+ Unfolding(..), SimpleUnfolding(..), FormSummary(..),
+ calcUnfoldingGuidance )
+import CoreUtils ( coreExprCc )
import CostCentre ( CostCentre, subsumedCosts, noCostCentreAttached )
import FiniteMap -- lots of things
-import Id ( idType, getIdUnfolding, getIdStrictness, idWantsToBeINLINEd,
- applyTypeEnvToId, getInlinePragma,
- nullIdEnv, growIdEnvList, rngIdEnv, lookupIdEnv,
- addOneToIdEnv, modifyIdEnv, mkIdSet, modifyIdEnv_Directly,
+import Id ( applyTypeEnvToId, getInlinePragma,
+ nullIdEnv, growIdEnvList, lookupIdEnv,
+ addOneToIdEnv, modifyIdEnv, modifyIdEnv_Directly,
IdEnv, IdSet, GenId, Id )
-import Literal ( isNoRepLit, Literal{-instances-} )
-import Maybes ( maybeToBool, expectJust )
-import Name ( isLocallyDefined )
+import Literal ( Literal{-instances-} )
+import Maybes ( expectJust )
import OccurAnal ( occurAnalyseExpr )
import PprCore -- various instances
import PprType ( GenType, GenTyVar )
)
import Unique ( Unique{-instance Outputable-}, Uniquable(..) )
import UniqFM ( addToUFM, addToUFM_C, ufmToList )
-import Util ( Eager, appEager, returnEager, runEager,
- zipEqual, thenCmp, cmpList )
+import Util ( Eager, returnEager, zipEqual, thenCmp, cmpList )
import Outputable
\end{code}
#include "HsVersions.h"
import Type ( Type, GenType, matchTys, tyVarsOfTypes )
-import TyVar ( TyVar, TyVarEnv, lookupTyVarEnv, tyVarSetToList )
+import TyVar ( TyVarEnv, lookupTyVarEnv, tyVarSetToList )
import Unify ( Subst, unifyTyListsX )
import Maybes
import Util ( assertPanic )
import CoreSyn
import Id ( GenId, idType, mkSysLocal, dataConArgTys, isDataCon, isNewCon, Id )
-import IdInfo ( mkStrictnessInfo, {-??nonAbsentArgs,-} Demand(..) )
+import IdInfo ( Demand(..) )
import PrelVals ( aBSENT_ERROR_ID, voidId )
import TysPrim ( voidTy )
import SrcLoc ( noSrcLoc )
-import Type ( isUnpointedType, mkTyVarTys, mkForAllTys, mkFunTys,
+import Type ( isUnpointedType, mkTyVarTys, mkFunTys,
splitForAllTys, splitFunTys,
splitAlgTyConApp_maybe,
Type
import BasicTypes ( NewOrData(..) )
import TyVar ( TyVar )
import PprType ( GenType, GenTyVar )
-import UniqSupply ( returnUs, thenUs, thenMaybeUs,
- getUniques, getUnique, UniqSM
- )
-import Util ( zipWithEqual, zipEqual )
+import UniqSupply ( returnUs, thenUs, getUniques, getUnique, UniqSM )
+import Util ( zipEqual )
import Outputable
-import List ( nub )
\end{code}
%************************************************************************
#include "HsVersions.h"
-import {-# SOURCE #-} Id ( Id, idType, idName )
+import {-# SOURCE #-} Id ( Id )
import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} Type ( Type )
import {-# SOURCE #-} SpecEnv ( SpecEnv )
import TyCon ( TyCon )
import TyVar ( TyVar )
-import Maybes ( assocMaybe )
import Name ( NamedThing(..), Name, getOccName )
import Unique ( Unique, Uniquable(..) )
import BasicTypes ( Unused )
import {-# SOURCE #-} Type ( Type )
import {-# SOURCE #-} Class ( Class )
-import {-# SOURCE #-} Id ( Id, isNullaryDataCon, idType )
+import {-# SOURCE #-} Id ( Id, isNullaryDataCon )
import {-# SOURCE #-} TysWiredIn ( tupleCon )
import Name ( Name, nameUnique, mkWiredInTyConName, NamedThing(getName) )
import Unique ( Unique, funTyConKey, Uniquable(..) )
import PrimRep ( PrimRep(..), isFollowableRep )
-import PrelMods ( pREL_GHC, pREL_TUP, pREL_BASE )
-import Lex ( mkTupNameStr )
-import SrcLoc ( SrcLoc, mkBuiltinSrcLoc )
-import Util ( nOfThem, isIn )
-import Outputable
+import PrelMods ( pREL_GHC )
+import Util ( panic )
\end{code}
\begin{code}
import Maybes ( maybeToBool, assocMaybe )
import PrimRep ( PrimRep(..) )
import Unique -- quite a few *Keys
-import Util ( thenCmp, zipEqual, zipWithEqual, assoc )
-import Outputable
+import Util ( thenCmp, panic )
\end{code}
import FastString
-import GlaExts ( Addr )
-import ArrBase ( indexAddrOffAddr )
+import GlaExts ( Addr )
+import ByteArray ( indexAddrOffAddr )
argv :: [FAST_STRING]
argv = unpackArgv ``prog_argv'' (``prog_argc''::Int)
#define ARR_ELT (COMMA)
-import Array
-import List
+import Util ( sortLt )
+
+-- GHC extensions
import ST
-import ArrBase
+import MutableArray
+
+-- std interfaces
import Maybe
-import Util ( sortLt )
+import Array
+import List
\end{code}
#define COMPILING_FAST_STRING
#include "HsVersions.h"
+#if __GLASGOW_HASKELL__ < 301
import PackBase
+import STBase ( StateAndPtr#(..) )
+import IOHandle ( filePtr, readHandle, writeHandle )
+import IOBase ( Handle__(..), IOError(..), IOErrorType(..),
+ IOResult(..), IO(..),
+ constructError
+ )
+#else
+import PrelPack
+import PrelST ( StateAndPtr#(..) )
+import PrelHandle ( filePtr, readHandle, writeHandle )
+import PrelIOBase ( Handle__(..), IOError(..), IOErrorType(..),
+ IOResult(..), IO(..),
+ constructError
+ )
+#endif
+
import PrimPacked
import GlaExts
-import Addr ( Addr(..) )
-import STBase ( StateAndPtr#(..) )
-import ArrBase ( MutableArray(..) )
-import Foreign ( ForeignObj(..) )
-import IOExts ( IOArray(..), newIOArray,
- IORef, newIORef, readIORef, writeIORef
- )
+import Addr ( Addr(..) )
+import MutableArray ( MutableArray(..) )
+import Foreign ( ForeignObj(..) )
+import IOExts ( IORef, newIORef, readIORef, writeIORef )
import IO
-import IOHandle ( filePtr, readHandle, writeHandle )
-import IOBase ( Handle__(..), IOError(..), IOErrorType(..),
- IOResult(..), IO(..),
- constructError
- )
#define hASH_TBL_SIZE 993
\end{code}
if l# ==# 0# then
return ()
else
- _readHandle handle >>= \ htype ->
+ readHandle handle >>= \ htype ->
case htype of
ErrorHandle ioError ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail ioError
ClosedHandle ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is closed")
SemiClosedHandle _ _ ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is closed")
ReadHandle _ _ _ ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
other ->
let fp = filePtr htype in
if l# ==# 0# then
return ()
else
- _readHandle handle >>= \ htype ->
+ readHandle handle >>= \ htype ->
case htype of
ErrorHandle ioError ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail ioError
ClosedHandle ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is closed")
SemiClosedHandle _ _ ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is closed")
ReadHandle _ _ _ ->
- _writeHandle handle htype >>
+ writeHandle handle htype >>
fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
other ->
let fp = filePtr htype in
#include "HsVersions.h"
-import Util ( isIn, isn'tIn )
+import Util ( isn'tIn )
import List ( union )
\end{code}
\begin{code}
unionLists :: (Eq a) => [a] -> [a] -> [a]
-#ifdef REALLY_HASKELL_1_3
unionLists = union
-#else
-unionLists [] [] = []
-unionLists [] b = b
-unionLists a [] = a
-unionLists (a:as) b
- | a `is_elem` b = unionLists as b
- | otherwise = a : unionLists as b
- where
- is_elem = isIn "unionLists"
-#endif
-
-{- UNUSED
-intersectLists :: (Eq a) => [a] -> [a] -> [a]
-intersectLists [] [] = []
-intersectLists [] b = []
-intersectLists a [] = []
-intersectLists (a:as) b
- | a `is_elem` b = a : intersectLists as b
- | otherwise = intersectLists as b
- where
- is_elem = isIn "intersectLists"
--}
\end{code}
Everything in the first list that is not in the second list:
flattenOrdList
) where
-
-import Util ( mapAccumB, mapAccumL, mapAccumR )
\end{code}
This section provides an ordering list that allows fine grain
#include "HsVersions.h"
import IO ( Handle, hPutChar, hPutStr, stderr, stdout )
-import CmdLineOpts ( opt_PprStyle_All, opt_PprStyle_Debug, opt_PprStyle_User, opt_PprUserLength )
+import CmdLineOpts ( opt_PprStyle_All, opt_PprStyle_Debug, opt_PprUserLength )
import FastString
import qualified Pretty
import Pretty ( Doc, Mode(..), TextDetails(..), fullRender )
import GlaExts
import Addr ( Addr(..) )
-import GHC
-import ArrBase
import ST
+import Foreign
+
+#if __GLASGOW_HASKELL__ < 301
+import ArrBase ( StateAndMutableByteArray#(..),
+ StateAndByteArray#(..) )
import STBase
-import IOBase ( ForeignObj(..) )
-import PackBase ( unpackCStringBA, packString )
+#else
+import PrelArr ( StateAndMutableByteArray#(..),
+ StateAndByteArray#(..) )
+import PrelST
+#endif
+
\end{code}
Return the length of a @\\NUL@ terminated character string:
unsafePerformIO (
_ccall_ strncmp (A# a1#) (A# a2#) (I# len#) >>= \ (I# x#) ->
return (x# ==# 0#))
- where
- bottom :: (Int,Int)
- bottom = error "eqStrPrefix"
eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
eqStrPrefixBA b1# b2# start# len# =
bottom :: (Int,Int)
bottom = error "eqStrPrefixFO"
\end{code}
-
-\begin{code}
-byteArrayToString :: ByteArray Int -> String
-byteArrayToString = unpackCStringBA
-\end{code}
-
-
-\begin{code}
-stringToByteArray :: String -> (ByteArray Int)
-stringToByteArray = packString
-\end{code}
#include "HsVersions.h"
import GlaExts
-import STBase
-import IOBase ( IO(..), IOResult(..) )
-import ArrBase
import ST
+
+#if __GLASGOW_HASKELL__ < 301
+import STBase ( ST(..), STret(..), StateAndPtr#(..) )
+import ArrBase ( StateAndMutableArray#(..) )
+import IOBase ( IO(..), IOResult(..) )
+#else
+import PrelST ( ST(..), STret(..), StateAndPtr#(..) )
+import PrelArr ( StateAndMutableArray#(..) )
+import PrelIOBase ( IO(..), IOResult(..) )
+#endif
+
\end{code}
@SST@ is very like the standard @ST@ monad, but it comes with its
import GlaExts
import Addr ( Addr(..) )
import Foreign
-import IOBase
-import IOHandle
import ST
-import STBase
-import Char (isDigit)
-import PackBase
+import IO ( openFile, hFileSize, hClose, IOMode(..) )
+
+#if __GLASGOW_HASKELL__ < 301
+import IOBase ( IOError(..), IOErrorType(..) )
+import IOHandle ( readHandle, writeHandle, filePtr )
+import PackBase ( unpackCStringBA )
+#else
+import PrelIOBase ( IOError(..), IOErrorType(..) )
+import PrelHandle ( readHandle, writeHandle, filePtr )
+import PrelPack ( unpackCStringBA )
+#endif
+
import PrimPacked
import FastString
-
+import Char (isDigit)
\end{code}
\begin{code}
-- makeForeignObj arr free_p >>= \ fo@(_ForeignObj fo#) ->
readHandle hndl >>= \ hndl_ ->
writeHandle hndl hndl_ >>
- let ptr = _filePtr hndl_ in
+ let ptr = filePtr hndl_ in
_ccall_ fread arr (1::Int) len_i ptr >>= \ (I# read#) ->
-- trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $
hClose hndl >>
import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily )
import Util
-import Outputable ( Outputable(..) )
-import SrcLoc ( SrcLoc )
import GlaExts -- Lots of Int# operations
#if ! OMIT_NATIVE_CODEGEN
import Maybes ( maybeToBool )
import UniqFM
import Unique ( Unique, Uniquable(..) )
-import SrcLoc ( SrcLoc )
-import Outputable ( Outputable(..) )
#if ! OMIT_NATIVE_CODEGEN
#define IF_NCG(a) a
projects / ghc-hetmet.git / commitdiff