import CoreSyn
import Bag
-import Kind ( hasMoreBoxityInfo, Kind{-instance-},
- isTypeKind, isBoxedTypeKind {- TEMP --SOF -} )
+import Kind ( hasMoreBoxityInfo, Kind{-instance-} )
import Literal ( literalType, Literal{-instance-} )
import Id ( idType, isBottomingId, dataConRepType, isDataCon, isNewCon, isAlgCon,
dataConArgTys, GenId{-instances-},
- emptyIdSet, mkIdSet, intersectIdSets,
+ emptyIdSet, mkIdSet,
unionIdSets, elementOfIdSet, IdSet,
Id
)
import PprCore
import ErrUtils ( doIfSet, ghcExit )
import PprType ( GenType, GenTyVar, TyCon )
-import PrimOp ( primOpType, PrimOp(..) )
+import PrimOp ( primOpType )
import PrimRep ( PrimRep(..) )
import SrcLoc ( SrcLoc )
import Type ( mkFunTy, splitFunTy_maybe, mkForAllTy,
splitForAllTy_maybe,
- isUnpointedType, typeKind, instantiateTy, splitSigmaTy,
+ isUnpointedType, typeKind, instantiateTy,
splitAlgTyConApp_maybe, Type
)
import TyCon ( isPrimTyCon, isDataTyCon )
import Util ( zipEqual )
import Outputable
-infixr 9 `thenL`, `seqL`, `thenMaybeL`, `seqMaybeL`
+infixr 9 `thenL`, `seqL`, `thenMaybeL`
\end{code}
%************************************************************************
(Nothing, errs2) -> (Nothing, errs2)
(Just r, errs2) -> k r spec loc scope errs2
-seqMaybeL :: LintM (Maybe a) -> LintM (Maybe b) -> LintM (Maybe b)
-seqMaybeL m k spec loc scope errs
- = case m spec loc scope errs of
- (Nothing, errs2) -> (Nothing, errs2)
- (Just _, errs2) -> k spec loc scope errs2
-
mapL :: (a -> LintM b) -> [a] -> LintM [b]
mapL f [] = returnL []
mapL f (x:xs)
checkIfSpecDoneL False msg True loc scope errs = ((), addErr errs msg loc)
checkIfSpecDoneL False msg False loc scope errs = ((), errs)
-addErrIfL pred spec
- = if pred then addErrL spec else returnL ()
-
addErrL :: ErrMsg -> LintM ()
addErrL msg spec loc scope errs = ((), addErr errs msg loc)
= ($$) (ptext SLIT("Type of case alternatives not the same:"))
(ppr alts)
-mkCaseDataConMsg :: CoreExpr -> ErrMsg
-mkCaseDataConMsg expr
- = ($$) (ptext SLIT("A case scrutinee not of data constructor type:"))
- (pprCoreExpr expr)
-
-mkCaseNotPrimMsg :: TyCon -> ErrMsg
-mkCaseNotPrimMsg tycon
- = ($$) (ptext SLIT("A primitive case on a non-primitive type:"))
- (ppr tycon)
-
-mkCasePrimMsg :: TyCon -> ErrMsg
-mkCasePrimMsg tycon
- = ($$) (ptext SLIT("An algebraic case on a primitive type:"))
- (ppr tycon)
-
mkCaseAbstractMsg :: TyCon -> ErrMsg
mkCaseAbstractMsg tycon
= ($$) (ptext SLIT("An algebraic case on some weird type:"))
ppr binder],
hsep [ptext SLIT("Binder's type:"), ppr (idType binder)]
]
-
-mkSpecTyAppMsg :: CoreArg -> ErrMsg
-mkSpecTyAppMsg arg
- = ($$)
- (ptext SLIT("Unboxed types in a type application (after specialisation):"))
- (ppr arg)
\end{code}
module Check ( check , ExhaustivePat, WarningPat, BoxedString(..) ) where
-import {-# SOURCE #-} DsExpr ( dsExpr )
-import {-# SOURCE #-} DsBinds ( dsBinds )
-
import HsSyn
-import TcHsSyn ( TypecheckedPat,
- TypecheckedMatch,
- TypecheckedHsBinds,
- TypecheckedHsExpr
- )
+import TcHsSyn ( TypecheckedPat )
import DsHsSyn ( outPatType )
import CoreSyn
-import DsMonad ( DsM, DsMatchContext(..),
- DsMatchKind(..)
- )
import DsUtils ( EquationInfo(..),
MatchResult(..),
EqnNo,
)
import Id ( idType,
Id,
- idName,
isTupleCon,
getIdArity
)
#include "HsVersions.h"
import CmdLineOpts ( opt_D_dump_ds )
-import HsSyn ( HsBinds, HsExpr, MonoBinds
- )
-import TcHsSyn ( TypecheckedMonoBinds, TypecheckedHsExpr
- )
+import HsSyn ( MonoBinds )
+import TcHsSyn ( TypecheckedMonoBinds )
import CoreSyn
import PprCore ( pprCoreBindings )
-import Name ( isExported )
import DsMonad
import DsBinds ( dsMonoBinds )
import DsUtils
-import Bag ( unionBags, isEmptyBag )
-import BasicTypes ( Module, RecFlag(..) )
-import CmdLineOpts ( opt_DoCoreLinting, opt_SccGroup, opt_SccProfilingOn )
-import CostCentre ( IsCafCC(..), mkAutoCC )
+import Bag ( isEmptyBag )
+import BasicTypes ( Module )
+import CmdLineOpts ( opt_SccGroup, opt_SccProfilingOn )
import CoreLift ( liftCoreBindings )
import CoreLint ( lintCoreBindings )
-import Id ( nullIdEnv, mkIdEnv, idType,
- DictVar, GenId, Id )
+import Id ( nullIdEnv, GenId, Id )
import ErrUtils ( dumpIfSet, doIfSet )
import Outputable
import UniqSupply ( splitUniqSupply, UniqSupply )
import CmdLineOpts ( opt_SccProfilingOn, opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs
)
-import CostCentre ( mkAutoCC, IsCafCC(..), mkAllDictsCC, preludeDictsCostCentre )
-import Id ( idType, DictVar, Id )
+import CostCentre ( mkAutoCC, IsCafCC(..), mkAllDictsCC )
+import Id ( idType, Id )
import Name ( isExported )
import Type ( mkTyVarTy, isDictTy, instantiateTy
)
-import TyVar ( tyVarSetToList, zipTyVarEnv )
+import TyVar ( zipTyVarEnv )
import TysPrim ( voidTy )
-import Util ( isIn )
-import Outputable
\end{code}
%************************************************************************
import TcHsSyn ( maybeBoxedPrimType )
import CoreUtils ( coreExprType )
-import Id ( Id(..), dataConArgTys, dataConTyCon, idType )
+import Id ( Id(..), dataConArgTys, idType )
import Maybes ( maybeToBool )
import PprType ( GenType{-instances-} )
import PrelVals ( packStringForCId )
Type
)
import TyCon ( tyConDataCons )
-import TysPrim ( byteArrayPrimTy, realWorldTy, realWorldStatePrimTy,
+import TysPrim ( byteArrayPrimTy, realWorldStatePrimTy,
byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
import TysWiredIn ( getStatePairingConInfo,
unitDataCon, stringTy,
import DsMonad
import DsCCall ( dsCCall )
-import DsHsSyn ( outPatType )
import DsListComp ( dsListComp )
-import DsUtils ( mkAppDs, mkConDs, mkPrimDs, dsExprToAtomGivenTy, mkTupleExpr,
- mkErrorAppDs, showForErr, EquationInfo,
- MatchResult, DsCoreArg
+import DsUtils ( mkAppDs, mkConDs, dsExprToAtomGivenTy,
+ mkErrorAppDs, showForErr, DsCoreArg
)
import Match ( matchWrapper )
-import CoreUtils ( coreExprType, substCoreExpr, argToExpr,
- mkCoreIfThenElse, unTagBinders )
+import CoreUtils ( coreExprType, mkCoreIfThenElse )
import CostCentre ( mkUserCC )
-import FieldLabel ( fieldLabelType, FieldLabel )
-import Id ( idType, nullIdEnv, addOneToIdEnv,
- dataConTyCon, dataConArgTys, dataConFieldLabels,
+import FieldLabel ( FieldLabel )
+import Id ( dataConTyCon, dataConArgTys, dataConFieldLabels,
recordSelectorFieldLabel, Id
)
import Literal ( mkMachInt, Literal(..) )
import Name ( Name{--O only-} )
-import PrelVals ( rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, voidId )
+import PrelVals ( rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID )
import TyCon ( isNewTyCon )
-import Type ( splitSigmaTy, splitFunTys, typePrimRep, mkTyConApp,
- splitAlgTyConApp, splitTyConApp_maybe, applyTy,
+import Type ( splitFunTys, typePrimRep, mkTyConApp,
+ splitAlgTyConApp, splitTyConApp_maybe,
splitAppTy, Type
)
-import TysPrim ( voidTy )
-import TysWiredIn ( mkTupleTy, tupleCon, nilDataCon, consDataCon, listTyCon, mkListTy,
+import TysWiredIn ( tupleCon, nilDataCon, consDataCon, listTyCon, mkListTy,
charDataCon, charTy
)
-import TyVar ( addToTyVarEnv, GenTyVar{-instance Eq-} )
+import TyVar ( GenTyVar{-instance Eq-} )
import Maybes ( maybeToBool )
import Util ( zipEqual )
import Outputable
#include "HsVersions.h"
-import HsSyn ( OutPat(..), HsBinds(..), MonoBinds(..),
- Sig, HsExpr, GRHSsAndBinds, Match, HsLit )
+import HsSyn ( OutPat(..), MonoBinds(..),
+ HsExpr, GRHSsAndBinds, Match, HsLit )
import TcHsSyn ( TypecheckedPat,
TypecheckedMonoBinds )
import Bag ( emptyBag, snocBag, bagToList, Bag )
import BasicTypes ( Module )
-import CoreSyn ( CoreExpr )
-import CoreUtils ( substCoreExpr )
import ErrUtils ( WarnMsg )
import HsSyn ( OutPat )
import Id ( mkSysLocal, mkIdWithNewUniq,
import Type ( Type )
import TyVar ( cloneTyVar, TyVar )
import UniqSupply ( splitUniqSupply, getUnique, getUniques,
- mapUs, thenUs, returnUs, UniqSM,
- UniqSupply )
-import Util ( assoc, mapAccumL, zipWithEqual, panic )
+ UniqSM, UniqSupply )
+import Util ( zipWithEqual, panic )
infixr 9 `thenDs`
\end{code}
#include "HsVersions.h"
-import {-# SOURCE #-} Match (match, matchSimply )
+import {-# SOURCE #-} Match ( matchSimply )
-import HsSyn ( HsExpr(..), OutPat(..), HsLit(..), Fixity,
- Match, HsBinds, Stmt, DoOrListComp, HsType, ArithSeqInfo )
+import HsSyn ( OutPat(..), Stmt, DoOrListComp )
import TcHsSyn ( TypecheckedPat )
import DsHsSyn ( outPatType, collectTypedPatBinders )
import CoreSyn
import CoreUtils ( coreExprType, mkCoreIfThenElse )
import PrelVals ( iRREFUT_PAT_ERROR_ID, voidId )
import Id ( idType, dataConArgTys,
- DataCon, DictVar, Id, GenId )
+ DataCon, Id, GenId )
import Literal ( Literal(..) )
import PrimOp ( PrimOp )
import TyCon ( isNewTyCon, tyConDataCons )
-import Type ( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTy,
+import Type ( mkRhoTy, mkFunTy,
isUnpointedType, mkTyConApp, splitAlgTyConApp,
Type
)
import BasicTypes ( Unused )
import TysPrim ( voidTy )
-import TysWiredIn ( tupleTyCon, unitDataCon, tupleCon )
+import TysWiredIn ( unitDataCon, tupleCon )
import UniqSet ( mkUniqSet, minusUniqSet, uniqSetToList, UniqSet )
import Unique ( Unique )
import Outputable
import {-# SOURCE #-} DsBinds ( dsBinds )
import CmdLineOpts ( opt_WarnIncompletePatterns, opt_WarnOverlappingPatterns,
- opt_PprUserLength,opt_WarnSimplePatterns
+ opt_WarnSimplePatterns
)
import HsSyn
import TcHsSyn ( TypecheckedPat, TypecheckedMatch,
TypecheckedHsBinds, TypecheckedHsExpr )
-import DsHsSyn ( outPatType, collectTypedPatBinders )
+import DsHsSyn ( outPatType )
import Check ( check, ExhaustivePat, WarningPat, BoxedString )
import CoreSyn
import CoreUtils ( coreExprType )
import PprType ( GenType{-instance-}, GenTyVar{-ditto-} )
import PrelVals ( pAT_ERROR_ID )
import Type ( isUnpointedType, splitAlgTyConApp,
- instantiateTauTy, Type
+ Type
)
import TyVar ( TyVar )
import TysPrim ( intPrimTy, charPrimTy, floatPrimTy, doublePrimTy,
import TysWiredIn ( nilDataCon, consDataCon, mkTupleTy, mkListTy,
charTy, charDataCon, intTy, intDataCon,
floatTy, floatDataCon, doubleTy, tupleCon,
- doubleDataCon, stringTy, addrTy,
+ doubleDataCon, addrTy,
addrDataCon, wordTy, wordDataCon
)
import UniqSet
import {-# SOURCE #-} DsExpr ( dsExpr )
import HsSyn ( HsLit(..), OutPat(..), HsExpr(..), Fixity,
- Match, HsBinds, Stmt(..), DoOrListComp, HsType, ArithSeqInfo )
-import TcHsSyn ( TypecheckedHsExpr, TypecheckedHsBinds,
- TypecheckedPat
- )
+ Match, HsBinds, DoOrListComp, HsType, ArithSeqInfo )
+import TcHsSyn ( TypecheckedHsExpr, TypecheckedPat )
import CoreSyn ( CoreExpr, CoreBinding, GenCoreExpr(..), GenCoreBinding(..) )
import Id ( GenId {- instance Eq -}, Id )
import Literal ( mkMachInt, Literal(..) )
import Maybes ( catMaybes )
-import Type ( isUnpointedType, Type )
+import Type ( Type )
import Util ( panic, assertPanic )
\end{code}
import {-# SOURCE #-} Simplify ( simplExpr )
-import Constants ( uNFOLDING_USE_THRESHOLD,
- uNFOLDING_CON_DISCOUNT_WEIGHT
- )
import CmdLineOpts ( switchIsOn, SimplifierSwitch(..) )
import CoreSyn
-import CoreUnfold ( Unfolding(..), UfExpr, RdrName, UnfoldingGuidance(..),
+import CoreUnfold ( Unfolding(..), UnfoldingGuidance(..),
SimpleUnfolding(..),
FormSummary, whnfOrBottom,
smallEnoughToInline )
#include "HsVersions.h"
import CmdLineOpts ( opt_SpecialiseOverloaded, opt_SpecialiseUnboxed,
- opt_SpecialiseAll, opt_PprUserLength
+ opt_SpecialiseAll
)
import Bag ( isEmptyBag, bagToList, Bag )
import Class ( Class )
import FiniteMap ( emptyFM, addListToFM_C, plusFM_C, keysFM,
lookupWithDefaultFM
)
-import Id ( idType, isDictFunId,
- isDefaultMethodId_maybe,
- Id
- )
+import Id ( Id )
import Maybes ( maybeToBool, catMaybes, firstJust )
import Name ( OccName, pprOccName, modAndOcc, NamedThing(..) )
import Outputable
-import PprType ( pprGenType, pprParendGenType, pprMaybeTy,
- TyCon
- )
+import PprType ( pprParendGenType, pprMaybeTy, TyCon )
import TyCon ( tyConTyVars )
import Type ( mkSigmaTy, instantiateTauTy, instantiateThetaTy,
splitSigmaTy, mkTyVarTy, mkForAllTys,
- getTyVar_maybe, isUnboxedType, Type
+ isUnboxedType, Type
)
import TyVar ( TyVar, mkTyVarEnv )
import Util ( equivClasses, zipWithEqual,
HsBinds(..), DoOrListComp(..),
unguardedRHS
)
-import RdrHsSyn ( RdrName(..), varQual, varUnqual, mkOpApp,
+import RdrHsSyn ( RdrName(..), varUnqual, mkOpApp,
RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat
)
import BasicTypes ( IfaceFlavour(..), RecFlag(..) )
-- friends:
import HsSyn -- oodles of it
import Id ( GenId(..), IdDetails, -- Can meddle modestly with Ids
- DictVar, idType, dataConArgTys,
- Id
+ dataConArgTys, Id
)
-- others:
zonkTcTypeToType, zonkTcTyVarToTyVar, zonkTcType
)
import TyCon ( isDataTyCon )
-import Type ( mkTyVarTy, tyVarsOfType, splitAlgTyConApp_maybe, isUnpointedType, Type )
-import TyVar ( TyVar, TyVarEnv, emptyTyVarEnv, growTyVarEnvList, emptyTyVarSet )
+import Type ( mkTyVarTy, splitAlgTyConApp_maybe, isUnpointedType, Type )
+import TyVar ( TyVar, TyVarEnv, emptyTyVarEnv, growTyVarEnvList )
import TysPrim ( voidTy )
import CoreSyn ( GenCoreExpr )
import Unique ( Unique ) -- instances
import Bag
import UniqFM
-import Util ( zipEqual )
import Outputable
\end{code}
RenamedSig, RenamedHsDecl
)
import TcHsSyn ( TcMonoBinds, TcIdOcc(..), TcIdBndr,
- maybeBoxedPrimType, mkHsTyLam, mkHsTyApp,
- )
+ maybeBoxedPrimType
+ )
import TcBinds ( tcPragmaSigs, sigThetaCtxt )
import TcClassDcl ( tcMethodBind, badMethodErr )
)
import CmdLineOpts ( opt_GlasgowExts, opt_WarnMissingMethods )
import Class ( classBigSig, Class )
-import Id ( idType, isNullaryDataCon, dataConArgTys, Id )
+import Id ( isNullaryDataCon, dataConArgTys, Id )
import Maybes ( maybeToBool, seqMaybe, catMaybes )
import Name ( nameOccName, mkLocalName,
isLocallyDefined, Module,
nest 4 (parens msg)
]
-instBndrErr bndr clas
- = hsep [ptext SLIT("Class"), quotes (ppr clas), ptext SLIT("does not have a method"), quotes (ppr bndr)]
-
derivingWhenInstanceExistsErr clas tycon
= hang (hsep [ptext SLIT("Deriving class"),
quotes (ppr clas),
4 (hsep [text "(Try either importing", ppr inst_ty,
text "non-abstractly or compile using -fno-prune-tydecls ..)"])
-instMethodNotInClassErr occ clas
- = hang (ptext SLIT("Instance mentions a method not in the class"))
- 4 (hsep [ptext SLIT("class") <+> quotes (ppr clas),
- ptext SLIT("method") <+> quotes (ppr occ)])
-
-patMonoBindsCtxt pbind
- = hang (ptext SLIT("In a pattern binding:"))
- 4 (ppr pbind)
-
-methodSigCtxt name ty
- = hang (hsep [ptext SLIT("When matching the definition of class method"),
- quotes (ppr name), ptext SLIT("to its signature :") ])
- 4 (ppr ty)
-
superClassCtxt = ptext SLIT("From the superclasses of the instance declaration")
\end{code}
import CmdLineOpts ( opt_D_dump_tc, opt_D_dump_deriv )
import HsSyn ( HsModule(..), HsBinds(..), MonoBinds(..), HsDecl(..) )
-import RnHsSyn ( RenamedHsModule, RenamedFixityDecl(..) )
-import TcHsSyn ( TypecheckedHsBinds, TypecheckedHsExpr,
- TypecheckedDictBinds, TcMonoBinds,
- TypecheckedMonoBinds,
- zonkTopBinds )
+import RnHsSyn ( RenamedHsModule )
+import TcHsSyn ( TcMonoBinds, TypecheckedMonoBinds, zonkTopBinds )
import TcMonad
import Inst ( Inst, emptyLIE, plusLIE )
import TcBinds ( tcTopBindsAndThen )
import TcClassDcl ( tcClassDecls2 )
import TcDefaults ( tcDefaults )
-import TcEnv ( TcIdOcc(..), tcExtendGlobalValEnv, tcExtendTyConEnv, getEnv_LocalIds,
+import TcEnv ( TcIdOcc(..), tcExtendGlobalValEnv, tcExtendTyConEnv,
getEnv_TyCons, getEnv_Classes, tcLookupLocalValue,
- tcLookupLocalValueByKey, tcLookupTyCon,
- tcLookupGlobalValueByKeyMaybe, initEnv )
+ tcLookupTyCon, initEnv )
import TcExpr ( tcId )
import TcIfaceSig ( tcInterfaceSigs )
import TcInstDcls ( tcInstDecls1, tcInstDecls2 )
import RnMonad ( RnNameSupply(..) )
import Bag ( isEmptyBag )
import ErrUtils ( WarnMsg, ErrMsg,
- pprBagOfErrors, dumpIfSet, ghcExit
+ pprBagOfErrors, dumpIfSet
)
-import Id ( idType, GenId, IdEnv, nullIdEnv )
-import Maybes ( catMaybes, MaybeErr(..) )
+import Id ( idType, GenId )
import Name ( Name, isLocallyDefined, pprModule, NamedThing(..) )
-import TyCon ( TyCon, isSynTyCon, tyConKind )
+import TyCon ( TyCon, tyConKind )
import Class ( Class, classSelIds, classTyCon )
-import Type ( mkTyConApp, mkSynTy, Type )
+import Type ( mkTyConApp, Type )
import TyVar ( emptyTyVarEnv )
import TysWiredIn ( unitTy )
-import PrelMods ( pREL_MAIN, mAIN )
+import PrelMods ( mAIN )
import PrelInfo ( main_NAME, ioTyCon_NAME )
import Unify ( unifyTauTy )
-import UniqFM ( lookupUFM_Directly, lookupWithDefaultUFM_Directly,
- filterUFM, eltsUFM )
import Unique ( Unique )
import UniqSupply ( UniqSupply )
import Util
import Bag ( Bag, isEmptyBag )
-import FiniteMap ( emptyFM, FiniteMap )
+import FiniteMap ( FiniteMap )
import Outputable
\end{code}
import CmdLineOpts ( opt_IrrefutableTuples )
import Id ( GenId, idType, Id )
import Kind ( Kind, mkBoxedTypeKind, mkTypeKind )
-import Maybes ( maybeToBool )
import PprType ( GenType, GenTyVar )
-import Type ( splitFunTys, splitRhoTy, splitSigmaTy, mkTyVarTys,
- splitFunTy_maybe, splitAlgTyConApp_maybe,
+import Type ( splitFunTys, splitRhoTy,
+ splitFunTy_maybe,
Type, GenType
)
import TyVar ( GenTyVar )
import TysPrim ( charPrimTy, intPrimTy, floatPrimTy,
doublePrimTy, addrPrimTy
)
-import TysWiredIn ( charTy, stringTy, mkListTy, mkTupleTy, addrTy )
+import TysWiredIn ( charTy, stringTy, mkListTy, mkTupleTy )
import Unique ( Unique, eqClassOpKey, geClassOpKey, minusClassOpKey )
import Util ( assertPanic, panic )
import Outputable
projects / ghc-hetmet.git / commitdiff