diff options
| author | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-01-24 19:40:06 -0800 |
|---|---|---|
| committer | Iavor S. Diatchki <iavor.diatchki@gmail.com> | 2012-01-24 19:40:06 -0800 |
| commit | 9c1575228173218a3cfa06ddbec3865b12d87713 (patch) | |
| tree | 52777ff46612b9b0d5135f7d79deb72ae8c1cabe | |
| parent | d0e3776f8e4d954160437db27465f1af3c2aea36 (diff) | |
| parent | f438722414782adfb9800b574ec8a1d7d5eafbbf (diff) | |
| download | haskell-9c1575228173218a3cfa06ddbec3865b12d87713.tar.gz | |
Merge remote-tracking branch 'origin/master' into type-nats
Conflicts:
compiler/typecheck/TcEvidence.lhs
99 files changed, 4560 insertions, 7403 deletions
diff --git a/.gitignore b/.gitignore index 2bfec1656b..e65a4c26ec 100644 --- a/.gitignore +++ b/.gitignore @@ -125,6 +125,8 @@ _darcs/ /docs/users_guide/ug-book.xml /docs/users_guide/ug-ent.xml /docs/users_guide/users_guide.xml +/docs/users_guide/users_guide.pdf +/docs/users_guide/users_guide.ps /docs/users_guide/users_guide/ /docs/users_guide/what_glasgow_exts_does.gen.xml /driver/ghc/dist/ @@ -182,6 +184,7 @@ _darcs/ /libraries/time/ /libraries/*/dist-boot/ /libraries/*/dist-install/ +/libraries/dist-haddock/ /mk/are-validating.mk /mk/build.mk /mk/config.h @@ -237,3 +240,5 @@ _darcs/ /extra-gcc-opts + +.tm_properties diff --git a/aclocal.m4 b/aclocal.m4 index 1c89e0d02a..8318452913 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -359,6 +359,7 @@ AC_DEFUN([FP_SETTINGS], then SettingsCCompilerCommand='$topdir/../mingw/bin/gcc.exe' SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 $CONF_GCC_LINKER_OPTS_STAGE2" + SettingsArCommand='$topdir/../mingw/bin/ar.exe' SettingsPerlCommand='$topdir/../perl/perl.exe' SettingsDllWrapCommand='$topdir/../mingw/bin/dllwrap.exe' SettingsWindresCommand='$topdir/../mingw/bin/windres.exe' @@ -366,6 +367,7 @@ AC_DEFUN([FP_SETTINGS], else SettingsCCompilerCommand="$WhatGccIsCalled" SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2 $CONF_GCC_LINKER_OPTS_STAGE2" + SettingsArCommand="$ArCmd" SettingsPerlCommand="$PerlCmd" SettingsDllWrapCommand="/bin/false" SettingsWindresCommand="/bin/false" @@ -385,6 +387,7 @@ AC_DEFUN([FP_SETTINGS], fi AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCCompilerFlags) + AC_SUBST(SettingsArCommand) AC_SUBST(SettingsPerlCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) @@ -1941,6 +1944,12 @@ AC_DEFUN([BOOTSTRAPPING_GHC_INFO_FIELD],[ if test $GhcCanonVersion -ge 701 then $1=`"$WithGhc" --info | grep "^ ,(\"$2\"," | sed -e 's/.*","//' -e 's/")$//'` + tmp=${$1#\$topdir/} + if test "${$1}" != "$tmp" + then + topdir=`"$WithGhc" --print-libdir | sed 's#\\\\#/#g'` + $1="$topdir/$tmp" + fi else $1=$3 fi diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 1d5a5b3cda..6518c5b5b0 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -333,16 +333,36 @@ emitPrimOp [res] FreezeArrayOp [src,src_off,n] = emitPrimOp [res] ThawArrayOp [src,src_off,n] = emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n +emitPrimOp [] CopyArrayArrayOp [src,src_off,dst,dst_off,n] = + doCopyArrayOp src src_off dst dst_off n +emitPrimOp [] CopyMutableArrayArrayOp [src,src_off,dst,dst_off,n] = + doCopyMutableArrayOp src src_off dst dst_off n + -- Reading/writing pointer arrays -emitPrimOp [r] ReadArrayOp [obj,ix] = doReadPtrArrayOp r obj ix -emitPrimOp [r] IndexArrayOp [obj,ix] = doReadPtrArrayOp r obj ix +emitPrimOp [res] ReadArrayOp [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] IndexArrayOp [obj,ix] = doReadPtrArrayOp res obj ix emitPrimOp [] WriteArrayOp [obj,ix,v] = doWritePtrArrayOp obj ix v +emitPrimOp [res] IndexArrayArrayOp_ByteArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] IndexArrayArrayOp_ArrayArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] ReadArrayArrayOp_ByteArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] ReadArrayArrayOp_MutableByteArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] ReadArrayArrayOp_ArrayArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [res] ReadArrayArrayOp_MutableArrayArray [obj,ix] = doReadPtrArrayOp res obj ix +emitPrimOp [] WriteArrayArrayOp_ByteArray [obj,ix,v] = doWritePtrArrayOp obj ix v +emitPrimOp [] WriteArrayArrayOp_MutableByteArray [obj,ix,v] = doWritePtrArrayOp obj ix v +emitPrimOp [] WriteArrayArrayOp_ArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v +emitPrimOp [] WriteArrayArrayOp_MutableArrayArray [obj,ix,v] = doWritePtrArrayOp obj ix v + emitPrimOp [res] SizeofArrayOp [arg] = emit $ mkAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord) emitPrimOp [res] SizeofMutableArrayOp [arg] = emitPrimOp [res] SizeofArrayOp [arg] +emitPrimOp [res] SizeofArrayArrayOp [arg] + = emitPrimOp [res] SizeofArrayOp [arg] +emitPrimOp [res] SizeofMutableArrayArrayOp [arg] + = emitPrimOp [res] SizeofArrayOp [arg] -- IndexXXXoffAddr diff --git a/compiler/coreSyn/CorePrep.lhs b/compiler/coreSyn/CorePrep.lhs index a8985d0019..ed288096f7 100644 --- a/compiler/coreSyn/CorePrep.lhs +++ b/compiler/coreSyn/CorePrep.lhs @@ -26,7 +26,7 @@ import CoreFVs import CoreMonad ( endPass, CoreToDo(..) ) import CoreSyn import CoreSubst -import MkCore +import MkCore hiding( FloatBind(..) ) -- We use our own FloatBind here import Type import Literal import Coercion diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index c18af8e189..d7296e3e25 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -343,6 +343,12 @@ Note [Type let] ~~~~~~~~~~~~~~~ See #type_let# +%************************************************************************ +%* * + Ticks +%* * +%************************************************************************ + \begin{code} -- | Allows attaching extra information to points in expressions data Tickish id = @@ -893,7 +899,7 @@ the occurrence info is wrong %************************************************************************ %* * -\subsection{The main data type} + AltCon %* * %************************************************************************ diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 47e31fa5cb..198ac7e610 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -21,7 +21,8 @@ module CoreUtils ( exprType, coreAltType, coreAltsType, exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, exprIsBottom, exprIsCheap, exprIsExpandable, exprIsCheap', CheapAppFun, - exprIsHNF, exprOkForSpeculation, exprIsBig, exprIsConLike, + exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, + exprIsBig, exprIsConLike, rhsIsStatic, isCheapApp, isExpandableApp, -- * Expression and bindings size @@ -181,6 +182,10 @@ mkCast :: CoreExpr -> Coercion -> CoreExpr mkCast e co | isReflCo co = e mkCast (Coercion e_co) co + | isCoVarType (pSnd (coercionKind co)) + -- The guard here checks that g has a (~#) on both sides, + -- otherwise decomposeCo fails. Can in principle happen + -- with unsafeCoerce = Coercion new_co where -- g :: (s1 ~# s2) ~# (t1 ~# t2) @@ -752,35 +757,39 @@ it's applied only to dictionaries. -- -- We can only do this if the @y + 1@ is ok for speculation: it has no -- side effects, and can't diverge or raise an exception. -exprOkForSpeculation :: Expr b -> Bool +exprOkForSpeculation, exprOkForSideEffects :: Expr b -> Bool +exprOkForSpeculation = expr_ok primOpOkForSpeculation +exprOkForSideEffects = expr_ok primOpOkForSideEffects -- Polymorphic in binder type -- There is one call at a non-Id binder type, in SetLevels -exprOkForSpeculation (Lit _) = True -exprOkForSpeculation (Type _) = True -exprOkForSpeculation (Coercion _) = True -exprOkForSpeculation (Var v) = appOkForSpeculation v [] -exprOkForSpeculation (Cast e _) = exprOkForSpeculation e + +expr_ok :: (PrimOp -> Bool) -> Expr b -> Bool +expr_ok _ (Lit _) = True +expr_ok _ (Type _) = True +expr_ok _ (Coercion _) = True +expr_ok primop_ok (Var v) = app_ok primop_ok v [] +expr_ok primop_ok (Cast e _) = expr_ok primop_ok e -- Tick annotations that *tick* cannot be speculated, because these -- are meant to identify whether or not (and how often) the particular -- source expression was evaluated at runtime. -exprOkForSpeculation (Tick tickish e) +expr_ok primop_ok (Tick tickish e) | tickishCounts tickish = False - | otherwise = exprOkForSpeculation e + | otherwise = expr_ok primop_ok e -exprOkForSpeculation (Case e _ _ alts) - = exprOkForSpeculation e -- Note [exprOkForSpeculation: case expressions] - && all (\(_,_,rhs) -> exprOkForSpeculation rhs) alts - && altsAreExhaustive alts -- Note [exprOkForSpeculation: exhaustive alts] +expr_ok primop_ok (Case e _ _ alts) + = expr_ok primop_ok e -- Note [exprOkForSpeculation: case expressions] + && all (\(_,_,rhs) -> expr_ok primop_ok rhs) alts + && altsAreExhaustive alts -- Note [Exhaustive alts] -exprOkForSpeculation other_expr +expr_ok primop_ok other_expr = case collectArgs other_expr of - (Var f, args) -> appOkForSpeculation f args + (Var f, args) -> app_ok primop_ok f args _ -> False ----------------------------- -appOkForSpeculation :: Id -> [Expr b] -> Bool -appOkForSpeculation fun args +app_ok :: (PrimOp -> Bool) -> Id -> [Expr b] -> Bool +app_ok primop_ok fun args = case idDetails fun of DFunId new_type -> not new_type -- DFuns terminate, unless the dict is implemented @@ -794,7 +803,7 @@ appOkForSpeculation fun args PrimOpId op | isDivOp op -- Special case for dividing operations that fail , [arg1, Lit lit] <- args -- only if the divisor is zero - -> not (isZeroLit lit) && exprOkForSpeculation arg1 + -> not (isZeroLit lit) && expr_ok primop_ok arg1 -- Often there is a literal divisor, and this -- can get rid of a thunk in an inner looop @@ -802,14 +811,14 @@ appOkForSpeculation fun args -> True | otherwise - -> primOpOkForSpeculation op && - all exprOkForSpeculation args - -- A bit conservative: we don't really need + -> primop_ok op -- A bit conservative: we don't really need + && all (expr_ok primop_ok) args + -- to care about lazy arguments, but this is easy _other -> isUnLiftedType (idType fun) -- c.f. the Var case of exprIsHNF || idArity fun > n_val_args -- Partial apps - || (n_val_args ==0 && + || (n_val_args == 0 && isEvaldUnfolding (idUnfolding fun)) -- Let-bound values where n_val_args = valArgCount args @@ -872,13 +881,13 @@ If exprOkForSpeculation doesn't look through case expressions, you get this: The inner case is redundant, and should be nuked. -Note [exprOkForSpeculation: exhaustive alts] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note [Exhaustive alts] +~~~~~~~~~~~~~~~~~~~~~~ We might have something like case x of { A -> ... _ -> ...(case x of { B -> ...; C -> ... })... -Here, the inner case is fine, becuase the A alternative +Here, the inner case is fine, because the A alternative can't happen, but it's not ok to float the inner case outside the outer one (even if we know x is evaluated outside), because then it would be non-exhaustive. See Trac #5453. diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index ae6b095f99..5d1c19bc5f 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -21,6 +21,9 @@ module MkCore ( mkFloatExpr, mkDoubleExpr, mkCharExpr, mkStringExpr, mkStringExprFS, + -- * Floats + FloatBind(..), wrapFloat, + -- * Constructing/deconstructing implicit parameter boxes mkIPUnbox, mkIPBox, @@ -389,6 +392,25 @@ mkBigCoreTupTy :: [Type] -> Type mkBigCoreTupTy = mkChunkified mkBoxedTupleTy \end{code} + +%************************************************************************ +%* * + Floats +%* * +%************************************************************************ + +\begin{code} +data FloatBind + = FloatLet CoreBind + | FloatCase CoreExpr Id AltCon [Var] + -- case e of y { C ys -> ... } + -- See Note [Floating cases] in SetLevels + +wrapFloat :: FloatBind -> CoreExpr -> CoreExpr +wrapFloat (FloatLet defns) body = Let defns body +wrapFloat (FloatCase e b con bs) body = Case e b (exprType body) [(con, bs, body)] +\end{code} + %************************************************************************ %* * \subsection{Tuple destructors} diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 84cb6d628f..2d0ad237fc 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -41,7 +41,8 @@ import CLabel import Util import Data.Array -import System.Directory ( createDirectoryIfMissing ) +import Data.Time +import System.Directory import Trace.Hpc.Mix import Trace.Hpc.Util @@ -158,7 +159,7 @@ writeMixEntries dflags mod count entries filename tabStop = 8 -- <tab> counts as a normal char in GHC's location ranges. createDirectoryIfMissing True hpc_mod_dir - modTime <- getModificationTime filename + modTime <- getModificationUTCTime filename let entries' = [ (hpcPos, box) | (span,_,_,box) <- entries, hpcPos <- [mkHpcPos span] ] when (length entries' /= count) $ do @@ -1097,7 +1098,7 @@ type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel) -- This hash only has to be hashed at Mix creation time, -- and is for sanity checking only. -mixHash :: FilePath -> Integer -> Int -> [MixEntry] -> Int +mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int mixHash file tm tabstop entries = fromIntegral $ hashString (show $ Mix file tm 0 tabstop entries) \end{code} diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 4320934f8e..172545daaf 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -52,7 +52,7 @@ import TysWiredIn ( eqBoxDataCon, tupleCon ) import Id import Class import DataCon ( dataConWorkId ) -import Name ( localiseName ) +import Name ( Name, localiseName ) import MkId ( seqId ) import Var import VarSet @@ -64,9 +64,11 @@ import Maybes import OrdList import Bag import BasicTypes hiding ( TopLevel ) +import DynFlags import FastString +import ErrUtils( MsgDoc ) import Util - +import Control.Monad( when ) import MonadUtils import Control.Monad(liftM) \end{code} @@ -401,6 +403,13 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) -- Moreover, classops don't (currently) have an inl_sat arity set -- (it would be Just 0) and that in turn makes makeCorePair bleat + | no_act_spec && isNeverActive rule_act + = putSrcSpanDs loc $ + do { warnDs (ptext (sLit "Ignoring useless SPECIALISE pragma for NOINLINE function:") + <+> quotes (ppr poly_id)) + ; return Nothing } -- Function is NOINLINE, and the specialiation inherits that + -- See Note [Activation pragmas for SPECIALISE] + | otherwise = putSrcSpanDs loc $ do { let poly_name = idName poly_id @@ -417,28 +426,6 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ; let spec_id = mkLocalId spec_name spec_ty `setInlinePragma` inl_prag `setIdUnfolding` spec_unf - id_inl = idInlinePragma poly_id - - -- See Note [Activation pragmas for SPECIALISE] - inl_prag | not (isDefaultInlinePragma spec_inl) = spec_inl - | not is_local_id -- See Note [Specialising imported functions] - -- in OccurAnal - , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma - | otherwise = id_inl - -- Get the INLINE pragma from SPECIALISE declaration, or, - -- failing that, from the original Id - - spec_prag_act = inlinePragmaActivation spec_inl - - -- See Note [Activation pragmas for SPECIALISE] - -- no_act_spec is True if the user didn't write an explicit - -- phase specification in the SPECIALISE pragma - no_act_spec = case inlinePragmaSpec spec_inl of - NoInline -> isNeverActive spec_prag_act - _ -> isAlwaysActive spec_prag_act - rule_act | no_act_spec = inlinePragmaActivation id_inl -- Inherit - | otherwise = spec_prag_act -- Specified by user - rule = mkRule False {- Not auto -} is_local_id (mkFastString ("SPEC " ++ showSDoc (ppr poly_name))) rule_act poly_name @@ -448,6 +435,9 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ; spec_rhs <- dsHsWrapper spec_co poly_rhs ; let spec_pair = makeCorePair spec_id False (dictArity bndrs) spec_rhs + ; dflags <- getDynFlags + ; when (isInlinePragma id_inl && wopt Opt_WarnPointlessPragmas dflags) + (warnDs (specOnInline poly_name)) ; return (Just (spec_pair `consOL` unf_pairs, rule)) } } } where @@ -462,6 +452,29 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) | otherwise = pprPanic "dsImpSpecs" (ppr poly_id) -- The type checker has checked that it *has* an unfolding + id_inl = idInlinePragma poly_id + + -- See Note [Activation pragmas for SPECIALISE] + inl_prag | not (isDefaultInlinePragma spec_inl) = spec_inl + | not is_local_id -- See Note [Specialising imported functions] + -- in OccurAnal + , isStrongLoopBreaker (idOccInfo poly_id) = neverInlinePragma + | otherwise = id_inl + -- Get the INLINE pragma from SPECIALISE declaration, or, + -- failing that, from the original Id + + spec_prag_act = inlinePragmaActivation spec_inl + + -- See Note [Activation pragmas for SPECIALISE] + -- no_act_spec is True if the user didn't write an explicit + -- phase specification in the SPECIALISE pragma + no_act_spec = case inlinePragmaSpec spec_inl of + NoInline -> isNeverActive spec_prag_act + _ -> isAlwaysActive spec_prag_act + rule_act | no_act_spec = inlinePragmaActivation id_inl -- Inherit + | otherwise = spec_prag_act -- Specified by user + + specUnfolding :: HsWrapper -> Type -> Unfolding -> DsM (Unfolding, OrdList (Id,CoreExpr)) {- [Dec 10: TEMPORARILY commented out, until we can straighten out how to @@ -474,6 +487,10 @@ specUnfolding wrap_fn spec_ty (DFunUnfolding _ _ ops) -} specUnfolding _ _ _ = return (noUnfolding, nilOL) + +specOnInline :: Name -> MsgDoc +specOnInline f = ptext (sLit "SPECIALISE pragma on INLINE function probably won't fire:") + <+> quotes (ppr f) \end{code} diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 65134ed85f..d31c77479d 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -685,7 +685,7 @@ makes all list literals be generated via the simple route. dsExplicitList :: PostTcType -> [LHsExpr Id] -> DsM CoreExpr -- See Note [Desugaring explicit lists] dsExplicitList elt_ty xs - = do { dflags <- getDOptsDs + = do { dflags <- getDynFlags ; xs' <- mapM dsLExpr xs ; let (dynamic_prefix, static_suffix) = spanTail is_static xs' ; if opt_SimpleListLiterals -- -fsimple-list-literals @@ -760,21 +760,21 @@ dsDo stmts = ASSERT( length rec_ids > 0 ) goL (new_bind_stmt : stmts) where - new_bind_stmt = L loc $ BindStmt (mkLHsPatTup later_pats) + new_bind_stmt = L loc $ BindStmt (mkBigLHsPatTup later_pats) mfix_app bind_op noSyntaxExpr -- Tuple cannot fail tup_ids = rec_ids ++ filterOut (`elem` rec_ids) later_ids - tup_ty = mkBoxedTupleTy (map idType tup_ids) -- Deals with singleton case + tup_ty = mkBigCoreTupTy (map idType tup_ids) -- Deals with singleton case rec_tup_pats = map nlVarPat tup_ids later_pats = rec_tup_pats rets = map noLoc rec_rets mfix_app = nlHsApp (noLoc mfix_op) mfix_arg mfix_arg = noLoc $ HsLam (MatchGroup [mkSimpleMatch [mfix_pat] body] (mkFunTy tup_ty body_ty)) - mfix_pat = noLoc $ LazyPat $ mkLHsPatTup rec_tup_pats + mfix_pat = noLoc $ LazyPat $ mkBigLHsPatTup rec_tup_pats body = noLoc $ HsDo DoExpr (rec_stmts ++ [ret_stmt]) body_ty - ret_app = nlHsApp (noLoc return_op) (mkLHsTupleExpr rets) + ret_app = nlHsApp (noLoc return_op) (mkBigLHsTup rets) ret_stmt = noLoc $ mkLastStmt ret_app -- This LastStmt will be desugared with dsDo, -- which ignores the return_op in the LastStmt, diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index cce8ba78c7..b613fbdcec 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -345,7 +345,7 @@ dsFExport fn_id co ext_name cconv isDyn = do -- The function returns t Nothing -> (orig_res_ty, False) - dflags <- getDOpts + dflags <- getDynFlags return $ mkFExportCBits dflags ext_name (if isDyn then Nothing else Just fn_id) diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index 4ad8006b39..917e8b19ed 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -47,7 +47,7 @@ dsListComp :: [LStmt Id] -> Type -- Type of entire list -> DsM CoreExpr dsListComp lquals res_ty = do - dflags <- getDOptsDs + dflags <- getDynFlags let quals = map unLoc lquals elt_ty = case tcTyConAppArgs res_ty of [elt_ty] -> elt_ty diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index 551165a3ad..e68e6db7c2 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -20,7 +20,7 @@ module DsMonad ( mkPrintUnqualifiedDs, newUnique, UniqSupply, newUniqueSupply, - getDOptsDs, getGhcModeDs, doptDs, woptDs, + getGhcModeDs, doptDs, woptDs, dsLookupGlobal, dsLookupGlobalId, dsDPHBuiltin, dsLookupTyCon, dsLookupDataCon, PArrBuiltin(..), @@ -267,7 +267,7 @@ initDsTc thing_inside = do { this_mod <- getModule ; tcg_env <- getGblEnv ; msg_var <- getErrsVar - ; dflags <- getDOpts + ; dflags <- getDynFlags ; let type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env ds_envs = mkDsEnvs dflags this_mod rdr_env type_env msg_var @@ -346,9 +346,6 @@ We can also reach out and either set/grab location information from the @SrcSpan@ being carried around. \begin{code} -getDOptsDs :: DsM DynFlags -getDOptsDs = getDOpts - doptDs :: DynFlag -> TcRnIf gbl lcl Bool doptDs = doptM @@ -356,7 +353,7 @@ woptDs :: WarningFlag -> TcRnIf gbl lcl Bool woptDs = woptM getGhcModeDs :: DsM GhcMode -getGhcModeDs = getDOptsDs >>= return . ghcMode +getGhcModeDs = getDynFlags >>= return . ghcMode getModuleDs :: DsM Module getModuleDs = do { env <- getGblEnv; return (ds_mod env) } diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index f2e3be8bb8..c80446a751 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -66,7 +66,7 @@ matchCheck :: DsMatchContext -> DsM MatchResult -- Desugared result! matchCheck ctx vars ty qs - = do { dflags <- getDOptsDs + = do { dflags <- getDynFlags ; matchCheck_really dflags ctx vars ty qs } matchCheck_really :: DynFlags diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index a9d86f88be..51ae1542e3 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -61,11 +61,14 @@ Library if !flag(base3) && !flag(base4) Build-Depends: base < 3 + if flag(stage1) && impl(ghc < 7.5) + Build-Depends: old-time >= 1 && < 1.1 + if flag(base3) || flag(base4) Build-Depends: directory >= 1 && < 1.2, process >= 1 && < 1.2, bytestring >= 0.9 && < 0.10, - old-time >= 1 && < 1.1, + time < 1.5, containers >= 0.1 && < 0.5, array >= 0.1 && < 0.4 diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 4d6f17129a..94462c5191 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -59,7 +59,6 @@ import Data.Word import Data.Array import Data.IORef import Control.Monad -import System.Time ( ClockTime(..) ) -- --------------------------------------------------------------------------- @@ -77,7 +76,7 @@ readBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath -> TcRnIf a b ModIface readBinIface checkHiWay traceBinIFaceReading hi_path = do ncu <- mkNameCacheUpdater - dflags <- getDOpts + dflags <- getDynFlags liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu readBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath @@ -618,16 +617,6 @@ instance Binary AvailInfo where ac <- get bh return (AvailTC ab ac) - --- where should this be located? -instance Binary ClockTime where - put_ bh (TOD x y) = put_ bh x >> put_ bh y - - get bh = do - x <- get bh - y <- get bh - return $ TOD x y - instance Binary Usage where put_ bh usg@UsagePackageModule{} = do putByte bh 0 diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 37379b5be4..107c24c94f 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -188,7 +188,7 @@ loadInterface doc_str mod from ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from) -- Check whether we have the interface already - ; dflags <- getDOpts + ; dflags <- getDynFlags ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of { Just iface -> return (Succeeded iface) ; -- Already loaded @@ -489,7 +489,7 @@ findAndReadIface doc_str mod hi_boot_file nest 4 (ptext (sLit "reason:") <+> doc_str)]) -- Check for GHC.Prim, and return its static interface - ; dflags <- getDOpts + ; dflags <- getDynFlags ; if mod == gHC_PRIM then return (Succeeded (ghcPrimIface, "<built in interface for GHC.Prim>")) @@ -526,7 +526,7 @@ findAndReadIface doc_str mod hi_boot_file }} ; err -> do { traceIf (ptext (sLit "...not found")) - ; dflags <- getDOpts + ; dflags <- getDynFlags ; return (Failed (cannotFindInterface dflags (moduleName mod) err)) } } diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 35b4c91f2a..9904042fe0 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -111,7 +111,6 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.IORef import System.FilePath -import System.Directory (getModificationTime) \end{code} @@ -595,8 +594,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- - flag abi hash mod_hash <- computeFingerprint putNameLiterally (map fst sorted_decls, - export_hash, - orphan_hash, + export_hash, -- includes orphan_hash mi_warns iface0, mi_vect_info iface0) @@ -623,7 +621,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls mi_orphan = not ( null orph_rules && null orph_insts && null orph_fis - && null (ifaceVectInfoVar (mi_vect_info iface0))), + && isNoIfaceVectInfo (mi_vect_info iface0)), mi_finsts = not . null $ mi_fam_insts iface0, mi_decls = sorted_decls, mi_hash_fn = lookupOccEnv local_env } @@ -886,7 +884,7 @@ mkOrphMap get_key decls mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> IO [Usage] mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files = do { eps <- hscEPS hsc_env - ; mtimes <- mapM getModificationTime dependent_files + ; mtimes <- mapM getModificationUTCTime dependent_files ; let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod dir_imp_mods used_names ; let usages = mod_usages ++ map to_file_usage (zip dependent_files mtimes) @@ -1334,7 +1332,7 @@ checkModUsage _this_pkg UsageFile{ usg_file_path = file, usg_mtime = old_mtime } = liftIO $ handleIO handle $ do - new_mtime <- getModificationTime file + new_mtime <- getModificationUTCTime file return $ old_mtime /= new_mtime where handle = diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 1854b77f87..5e7d25895a 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -745,9 +745,9 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo ; tyConRes1 <- mapM (vectTyConVectMapping varsSet) tycons ; tyConRes2 <- mapM (vectTyConReuseMapping varsSet) tyconsReuse ; vScalarVars <- mapM vectVar scalarVars - ; let (vTyCons, vDataCons) = unzip (tyConRes1 ++ tyConRes2) + ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2) ; return $ VectInfo - { vectInfoVar = mkVarEnv vVars + { vectInfoVar = mkVarEnv vVars `extendVarEnvList` concat vScSels , vectInfoTyCon = mkNameEnv vTyCons , vectInfoDataCon = mkNameEnv (concat vDataCons) , vectInfoScalarVars = mkVarSet vScalarVars @@ -765,6 +765,19 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo tcIfaceExtId vName ; return (var, (var, vVar)) } + -- where + -- lookupLocalOrExternalId name + -- = do { let mb_id = lookupTypeEnv typeEnv name + -- ; case mb_id of + -- -- id is local + -- Just (AnId id) -> return id + -- -- name is not an Id => internal inconsistency + -- Just _ -> notAnIdErr + -- -- Id is external + -- Nothing -> tcIfaceExtId name + -- } + -- + -- notAnIdErr = pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name) vectVar name = forkM (ptext (sLit "vect scalar var") <+> ppr name) $ @@ -779,13 +792,17 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo = vectTyConMapping vars name name vectTyConMapping vars name vName - = do { tycon <- lookupLocalOrExternal name - ; vTycon <- lookupLocalOrExternal vName + = do { tycon <- lookupLocalOrExternalTyCon name + ; vTycon <- forkM (ptext (sLit "vTycon of") <+> ppr vName) $ + lookupLocalOrExternalTyCon vName - -- map the data constructors of the original type constructor to those of the + -- Map the data constructors of the original type constructor to those of the -- vectorised type constructor /unless/ the type constructor was vectorised -- abstractly; if it was vectorised abstractly, the workers of its data constructors - -- do not appear in the set of vectorised variables + -- do not appear in the set of vectorised variables. + -- + -- NB: This is lazy! We don't pull at the type constructors before we actually use + -- the data constructor mapping. ; let isAbstract | isClassTyCon tycon = False | datacon:_ <- tyConDataCons tycon = not $ dataConWrapId datacon `elemVarSet` vars @@ -796,14 +813,25 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo (tyConDataCons vTycon) ] + -- Map the (implicit) superclass and methods selectors as they don't occur in + -- the var map. + vScSels | Just cls <- tyConClass_maybe tycon + , Just vCls <- tyConClass_maybe vTycon + = [ (sel, (sel, vSel)) + | (sel, vSel) <- zip (classAllSelIds cls) (classAllSelIds vCls) + ] + | otherwise + = [] + ; return ( (name, (tycon, vTycon)) -- (T, T_v) , vDataCons -- list of (Ci, Ci_v) + , vScSels -- list of (seli, seli_v) ) } where -- we need a fully defined version of the type constructor to be able to extract -- its data constructors etc. - lookupLocalOrExternal name + lookupLocalOrExternalTyCon name = do { let mb_tycon = lookupTypeEnv typeEnv name ; case mb_tycon of -- tycon is local diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 07e53fb731..35de40bdc4 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -7,6 +7,7 @@ module Llvm.Types where #include "HsVersions.h" import Data.Char +import Data.Int import Data.List (intercalate) import Numeric @@ -223,7 +224,9 @@ getPlainName (LMLitVar x ) = getLit x -- | Print a literal value. No type. getLit :: LlvmLit -> String -getLit (LMIntLit i _ ) = show ((fromInteger i)::Int) +getLit (LMIntLit i (LMInt 32)) = show (fromInteger i :: Int32) +getLit (LMIntLit i (LMInt 64)) = show (fromInteger i :: Int64) +getLit (LMIntLit i _ ) = show (fromInteger i :: Int) getLit (LMFloatLit r LMFloat ) = fToStr $ realToFrac r getLit (LMFloatLit r LMDouble) = dToStr r getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index f239ee50cf..531d90a8ee 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -27,6 +27,7 @@ import UniqSupply import Util import SysTools ( figureLlvmVersion ) +import Data.IORef ( writeIORef ) import Data.Maybe ( fromMaybe ) import System.IO @@ -37,7 +38,7 @@ llvmCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmmGroup] -> IO () llvmCodeGen dflags h us cmms = let cmm = concat cmms (cdata,env) = {-# SCC "llvm_split" #-} - foldr split ([],initLlvmEnv (targetPlatform dflags)) cmm + foldr split ([], initLlvmEnv dflags) cmm split (CmmData s d' ) (d,e) = ((s,d'):d,e) split (CmmProc i l _) (d,e) = let lbl = strCLabel_llvm env $ case i of @@ -47,10 +48,12 @@ llvmCodeGen dflags h us cmms in (d,env') in do showPass dflags "LlVM CodeGen" - bufh <- newBufHandle h dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" $ docToSDoc pprLlvmHeader + bufh <- newBufHandle h Prt.bufLeftRender bufh $ pprLlvmHeader ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags + -- cache llvm version for later use + writeIORef (llvmVersion dflags) ver env' <- {-# SCC "llvm_datas_gen" #-} cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata [] {-# SCC "llvm_procs_gen" #-} diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index a896cdd482..9bdb115505 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -13,7 +13,7 @@ module LlvmCodeGen.Base ( LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert, funLookup, funInsert, getLlvmVer, setLlvmVer, getLlvmPlatform, - ghcInternalFunctions, + getDflags, ghcInternalFunctions, cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy, llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign, @@ -32,6 +32,7 @@ import CLabel import CgUtils ( activeStgRegs ) import Config import Constants +import DynFlags import FastString import OldCmm import qualified Outputable as Outp @@ -150,12 +151,13 @@ defaultLlvmVersion = 28 -- -- two maps, one for functions and one for local vars. -newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion, Platform) +newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion, DynFlags) + type LlvmEnvMap = UniqFM LlvmType -- | Get initial Llvm environment. -initLlvmEnv :: Platform -> LlvmEnv -initLlvmEnv platform = LlvmEnv (initFuncs, emptyUFM, defaultLlvmVersion, platform) +initLlvmEnv :: DynFlags -> LlvmEnv +initLlvmEnv dflags = LlvmEnv (initFuncs, emptyUFM, defaultLlvmVersion, dflags) where initFuncs = listToUFM $ [ (n, LMFunction ty) | (n, ty) <- ghcInternalFunctions ] -- | Here we pre-initialise some functions that are used internally by GHC @@ -211,7 +213,11 @@ setLlvmVer n (LlvmEnv (e1, e2, _, p)) = LlvmEnv (e1, e2, n, p) -- | Get the platform we are generating code for getLlvmPlatform :: LlvmEnv -> Platform -getLlvmPlatform (LlvmEnv (_, _, _, p)) = p +getLlvmPlatform (LlvmEnv (_, _, _, d)) = targetPlatform d + +-- | Get the DynFlags for this compilation pass +getDflags :: LlvmEnv -> DynFlags +getDflags (LlvmEnv (_, _, _, d)) = d -- ---------------------------------------------------------------------------- -- * Label handling diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 4309dcdae1..d5037828c7 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -16,13 +16,14 @@ import CgUtils ( activeStgRegs, callerSaves ) import CLabel import OldCmm import qualified OldPprCmm as PprCmm -import OrdList +import DynFlags import FastString import ForeignCall import Outputable hiding ( panic, pprPanic ) import qualified Outputable import Platform +import OrdList import UniqSupply import Unique import Util @@ -475,7 +476,7 @@ genJump :: LlvmEnv -> CmmExpr -> Maybe [GlobalReg] -> UniqSM StmtData -- Call to known function genJump env (CmmLit (CmmLabel lbl)) live = do (env', vf, stmts, top) <- getHsFunc env lbl - (stgRegs, stgStmts) <- funEpilogue live + (stgRegs, stgStmts) <- funEpilogue env live let s1 = Expr $ Call TailCall vf stgRegs llvmStdFunAttrs let s2 = Return Nothing return (env', stmts `appOL` stgStmts `snocOL` s1 `snocOL` s2, top) @@ -494,7 +495,7 @@ genJump env expr live = do ++ show (ty) ++ ")" (v1, s1) <- doExpr (pLift fty) $ Cast cast vf (pLift fty) - (stgRegs, stgStmts) <- funEpilogue live + (stgRegs, stgStmts) <- funEpilogue env live let s2 = Expr $ Call TailCall v1 stgRegs llvmStdFunAttrs let s3 = Return Nothing return (env', stmts `snocOL` s1 `appOL` stgStmts `snocOL` s2 `snocOL` s3, @@ -550,7 +551,7 @@ genStore env addr@(CmmMachOp (MO_Sub _) [ = genStore_fast env addr r (negate $ fromInteger n) val -- generic case -genStore env addr val = genStore_slow env addr val [top] +genStore env addr val = genStore_slow env addr val [other] -- | CmmStore operation -- This is a special case for storing to a global register pointer @@ -1032,7 +1033,7 @@ genLoad env e@(CmmMachOp (MO_Sub _) [ = genLoad_fast env e r (negate $ fromInteger n) ty -- generic case -genLoad env e ty = genLoad_slow env e ty [top] +genLoad env e ty = genLoad_slow env e ty [other] -- | Handle CmmLoad expression. -- This is a special case for loading from a global register pointer @@ -1200,29 +1201,33 @@ funPrologue = concat $ map getReg activeStgRegs -- | Function epilogue. Load STG variables to use as argument for call. -funEpilogue :: Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) -funEpilogue Nothing = do +-- STG Liveness optimisation done here. +funEpilogue :: LlvmEnv -> Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) + +-- Have information and liveness optimisation is enabled +funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do loads <- mapM loadExpr activeStgRegs let (vars, stmts) = unzip loads return (vars, concatOL stmts) where - loadExpr r = do + loadExpr r | r `elem` alwaysLive || r `elem` live = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg return (v, unitOL s) + loadExpr r = do + let ty = (pLower . getVarType $ lmGlobalRegVar r) + return (LMLitVar $ LMUndefLit ty, unitOL Nop) -funEpilogue (Just live) = do +-- don't do liveness optimisation +funEpilogue _ _ = do loads <- mapM loadExpr activeStgRegs let (vars, stmts) = unzip loads return (vars, concatOL stmts) where - loadExpr r | r `elem` alwaysLive || r `elem` live = do + loadExpr r = do let reg = lmGlobalRegVar r (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg return (v, unitOL s) - loadExpr r = do - let ty = (pLower . getVarType $ lmGlobalRegVar r) - return (LMLitVar $ LMUndefLit ty, unitOL Nop) -- | A serries of statements to trash all the STG registers. diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs index 55b2e0db80..b7ff9f008e 100644 --- a/compiler/llvmGen/LlvmCodeGen/Regs.hs +++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs @@ -4,7 +4,7 @@ module LlvmCodeGen.Regs ( lmGlobalRegArg, lmGlobalRegVar, alwaysLive, - stgTBAA, top, base, stack, heap, rx, tbaa, getTBAA + stgTBAA, top, base, stack, heap, rx, other, tbaa, getTBAA ) where #include "HsVersions.h" @@ -70,23 +70,30 @@ stgTBAA , MetaUnamed heapN [MetaStr (fsLit "heap"), MetaNode topN] , MetaUnamed rxN [MetaStr (fsLit "rx"), MetaNode heapN] , MetaUnamed baseN [MetaStr (fsLit "base"), MetaNode topN] + -- FIX: Not 100% sure about 'others' place. Might need to be under 'heap'. + -- OR I think the big thing is Sp is never aliased, so might want + -- to change the hieracy to have Sp on its own branch that is never + -- aliased (e.g never use top as a TBAA node). + , MetaUnamed otherN [MetaStr (fsLit "other"), MetaNode topN] ] -- | Id values -topN, stackN, heapN, rxN, baseN :: LlvmMetaUnamed +topN, stackN, heapN, rxN, baseN, otherN:: LlvmMetaUnamed topN = LMMetaUnamed 0 stackN = LMMetaUnamed 1 heapN = LMMetaUnamed 2 rxN = LMMetaUnamed 3 baseN = LMMetaUnamed 4 +otherN = LMMetaUnamed 5 -- | The various TBAA types -top, heap, stack, rx, base :: MetaData +top, heap, stack, rx, base, other :: MetaData top = (tbaa, topN) heap = (tbaa, heapN) stack = (tbaa, stackN) rx = (tbaa, rxN) base = (tbaa, baseN) +other = (tbaa, otherN) -- | The TBAA metadata identifier tbaa :: LMString diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index e845460413..a9ab3f66b7 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -4,13 +4,6 @@ \section{Code output phase} \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 CodeOutput( codeOutput, outputForeignStubs ) where #include "HsVersions.h" @@ -18,11 +11,11 @@ module CodeOutput( codeOutput, outputForeignStubs ) where import AsmCodeGen ( nativeCodeGen ) import LlvmCodeGen ( llvmCodeGen ) -import UniqSupply ( mkSplitUniqSupply ) +import UniqSupply ( mkSplitUniqSupply ) -import Finder ( mkStubPaths ) -import PprC ( writeCs ) -import CmmLint ( cmmLint ) +import Finder ( mkStubPaths ) +import PprC ( writeCs ) +import CmmLint ( cmmLint ) import Packages import Util import OldCmm ( RawCmmGroup ) @@ -31,10 +24,10 @@ import DynFlags import Config import SysTools -import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) +import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) import Outputable import Module -import Maybes ( firstJusts ) +import Maybes ( firstJusts ) import Control.Exception import Control.Monad @@ -44,50 +37,44 @@ import System.IO \end{code} %************************************************************************ -%* * +%* * \subsection{Steering} -%* * +%* * %************************************************************************ \begin{code} codeOutput :: DynFlags - -> Module - -> ModLocation - -> ForeignStubs - -> [PackageId] + -> Module + -> ModLocation + -> ForeignStubs + -> [PackageId] -> [RawCmmGroup] -- Compiled C-- -> IO (Bool{-stub_h_exists-}, Maybe FilePath{-stub_c_exists-}) codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC = - -- You can have C (c_output) or assembly-language (ncg_output), - -- but not both. [Allowing for both gives a space leak on - -- flat_abstractC. WDP 94/10] - - -- Dunno if the above comment is still meaningful now. JRS 001024. - - do { when (dopt Opt_DoCmmLinting dflags) $ do - { showPass dflags "CmmLint" - ; let lints = map (cmmLint (targetPlatform dflags)) flat_abstractC - ; case firstJusts lints of - Just err -> do { printDump err - ; ghcExit dflags 1 - } - Nothing -> return () - } - - ; showPass dflags "CodeOutput" - ; let filenm = hscOutName dflags - ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs - ; case hscTarget dflags of { + do { when (dopt Opt_DoCmmLinting dflags) $ do + { showPass dflags "CmmLint" + ; let lints = map (cmmLint (targetPlatform dflags)) flat_abstractC + ; case firstJusts lints of + Just err -> do { printDump err + ; ghcExit dflags 1 + } + Nothing -> return () + } + + ; showPass dflags "CodeOutput" + ; let filenm = hscOutName dflags + ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs + ; case hscTarget dflags of { HscInterpreted -> return (); HscAsm -> outputAsm dflags filenm flat_abstractC; HscC -> outputC dflags filenm flat_abstractC pkg_deps; HscLlvm -> outputLlvm dflags filenm flat_abstractC; HscNothing -> panic "codeOutput: HscNothing" - } - ; return stubs_exist - } + } + ; return stubs_exist + } doOutput :: String -> (Handle -> IO ()) -> IO () doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action @@ -95,9 +82,9 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action %************************************************************************ -%* * +%* * \subsection{C} -%* * +%* * %************************************************************************ \begin{code} @@ -118,26 +105,26 @@ outputC dflags filenm flat_absC packages let rts = getPackageDetails (pkgState dflags) rtsPackageId let cc_injects = unlines (map mk_include (includes rts)) - mk_include h_file = - case h_file of - '"':_{-"-} -> "#include "++h_file - '<':_ -> "#include "++h_file - _ -> "#include \""++h_file++"\"" + mk_include h_file = + case h_file of + '"':_{-"-} -> "#include "++h_file + '<':_ -> "#include "++h_file + _ -> "#include \""++h_file++"\"" pkg_configs <- getPreloadPackagesAnd dflags packages let pkg_names = map (display.sourcePackageId) pkg_configs doOutput filenm $ \ h -> do - hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") - hPutStr h cc_injects - writeCs dflags h flat_absC + hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") + hPutStr h cc_injects + writeCs dflags h flat_absC \end{code} %************************************************************************ -%* * +%* * \subsection{Assembler} -%* * +%* * %************************************************************************ \begin{code} @@ -156,9 +143,9 @@ outputAsm dflags filenm flat_absC %************************************************************************ -%* * +%* * \subsection{LLVM} -%* * +%* * %************************************************************************ \begin{code} @@ -172,14 +159,14 @@ outputLlvm dflags filenm flat_absC %************************************************************************ -%* * +%* * \subsection{Foreign import/export} -%* * +%* * %************************************************************************ \begin{code} outputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs - -> IO (Bool, -- Header file created + -> IO (Bool, -- Header file created Maybe FilePath) -- C file created outputForeignStubs dflags mod location stubs = do @@ -188,54 +175,54 @@ outputForeignStubs dflags mod location stubs case stubs of NoStubs -> do - -- When compiling External Core files, may need to use stub - -- files from a previous compilation + -- When compiling External Core files, may need to use stub + -- files from a previous compilation stub_h_exists <- doesFileExist stub_h return (stub_h_exists, Nothing) ForeignStubs h_code c_code -> do let - stub_c_output_d = pprCode CStyle c_code - stub_c_output_w = showSDoc stub_c_output_d - - -- Header file protos for "foreign export"ed functions. - stub_h_output_d = pprCode CStyle h_code - stub_h_output_w = showSDoc stub_h_output_d - -- in + stub_c_output_d = pprCode CStyle c_code + stub_c_output_w = showSDoc stub_c_output_d + + -- Header file protos for "foreign export"ed functions. + stub_h_output_d = pprCode CStyle h_code + stub_h_output_w = showSDoc stub_h_output_d + -- in createDirectoryHierarchy (takeDirectory stub_h) - dumpIfSet_dyn dflags Opt_D_dump_foreign + dumpIfSet_dyn dflags Opt_D_dump_foreign "Foreign export header file" stub_h_output_d - -- we need the #includes from the rts package for the stub files - let rts_includes = - let rts_pkg = getPackageDetails (pkgState dflags) rtsPackageId in - concatMap mk_include (includes rts_pkg) - mk_include i = "#include \"" ++ i ++ "\"\n" + -- we need the #includes from the rts package for the stub files + let rts_includes = + let rts_pkg = getPackageDetails (pkgState dflags) rtsPackageId in + concatMap mk_include (includes rts_pkg) + mk_include i = "#include \"" ++ i ++ "\"\n" -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes | cLibFFI = "#include \"ffi.h\"\n" | otherwise = "" - stub_h_file_exists + stub_h_file_exists <- outputForeignStubs_help stub_h stub_h_output_w - ("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr + ("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr - dumpIfSet_dyn dflags Opt_D_dump_foreign + dumpIfSet_dyn dflags Opt_D_dump_foreign "Foreign export stubs" stub_c_output_d - stub_c_file_exists + stub_c_file_exists <- outputForeignStubs_help stub_c stub_c_output_w - ("#define IN_STG_CODE 0\n" ++ - "#include \"Rts.h\"\n" ++ - rts_includes ++ - ffi_includes ++ - cplusplus_hdr) - cplusplus_ftr - -- We're adding the default hc_header to the stub file, but this - -- isn't really HC code, so we need to define IN_STG_CODE==0 to - -- avoid the register variables etc. being enabled. + ("#define IN_STG_CODE 0\n" ++ + "#include \"Rts.h\"\n" ++ + rts_includes ++ + ffi_includes ++ + cplusplus_hdr) + cplusplus_ftr + -- We're adding the default hc_header to the stub file, but this + -- isn't really HC code, so we need to define IN_STG_CODE==0 to + -- avoid the register variables etc. being enabled. return (stub_h_file_exists, if stub_c_file_exists then Just stub_c diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 0e8990777b..df6e7fd163 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -190,7 +190,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) (Just location) maybe_stub_o -- The object filename comes from the ModLocation - o_time <- getModificationTime object_filename + o_time <- getModificationUTCTime object_filename return ([DotO object_filename], o_time) let linkable = LM unlinked_time this_mod hs_unlinked @@ -353,13 +353,13 @@ linkingNeeded dflags linkables pkg_deps = do -- modification times on all of the objects and libraries, then omit -- linking (unless the -fforce-recomp flag was given). let exe_file = exeFileName dflags - e_exe_time <- tryIO $ getModificationTime exe_file + e_exe_time <- tryIO $ getModificationUTCTime exe_file case e_exe_time of Left _ -> return True Right t -> do -- first check object files and extra_ld_inputs extra_ld_inputs <- readIORef v_Ld_inputs - e_extra_times <- mapM (tryIO . getModificationTime) extra_ld_inputs + e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs let (errs,extra_times) = splitEithers e_extra_times let obj_times = map linkableTime linkables ++ extra_times if not (null errs) || any (t <) obj_times @@ -375,7 +375,7 @@ linkingNeeded dflags linkables pkg_deps = do pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs if any isNothing pkg_libfiles then return True else do - e_lib_times <- mapM (tryIO . getModificationTime) + e_lib_times <- mapM (tryIO . getModificationUTCTime) (catMaybes pkg_libfiles) let (lib_errs,lib_times) = splitEithers e_lib_times if not (null lib_errs) || any (t <) lib_times @@ -906,7 +906,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 -- changed (which the compiler itself figures out). -- Setting source_unchanged to False tells the compiler that M.o is out of -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless. - src_timestamp <- io $ getModificationTime (basename <.> suff) + src_timestamp <- io $ getModificationUTCTime (basename <.> suff) let hsc_lang = hscTarget dflags source_unchanged <- io $ @@ -919,7 +919,7 @@ runPhase (Hsc src_flavour) input_fn dflags0 else do o_file_exists <- doesFileExist o_file if not o_file_exists then return SourceModified -- Need to recompile - else do t2 <- getModificationTime o_file + else do t2 <- getModificationUTCTime o_file if t2 > src_timestamp then return SourceUnmodified else return SourceModified @@ -1306,15 +1306,21 @@ runPhase SplitAs _input_fn dflags runPhase LlvmOpt input_fn dflags = do - let lo_opts = getOpts dflags opt_lo - let opt_lvl = max 0 (min 2 $ optLevel dflags) - -- don't specify anything if user has specified commands. We do this for - -- opt but not llc since opt is very specifically for optimisation passes - -- only, so if the user is passing us extra options we assume they know - -- what they are doing and don't get in the way. - let optFlag = if null lo_opts - then [SysTools.Option (llvmOpts !! opt_lvl)] - else [] + ver <- io $ readIORef (llvmVersion dflags) + + let lo_opts = getOpts dflags opt_lo + opt_lvl = max 0 (min 2 $ optLevel dflags) + -- don't specify anything if user has specified commands. We do this + -- for opt but not llc since opt is very specifically for optimisation + -- passes only, so if the user is passing us extra options we assume + -- they know what they are doing and don't get in the way. + optFlag = if null lo_opts + then [SysTools.Option (llvmOpts !! opt_lvl)] + else [] + tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier + | dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + | otherwise = "--enable-tbaa=false" + output_fn <- phaseOutputFilename LlvmLlc @@ -1323,6 +1329,7 @@ runPhase LlvmOpt input_fn dflags SysTools.Option "-o", SysTools.FileOption "" output_fn] ++ optFlag + ++ [SysTools.Option tbaa] ++ map SysTools.Option lo_opts) return (LlvmLlc, output_fn) @@ -1336,11 +1343,16 @@ runPhase LlvmOpt input_fn dflags runPhase LlvmLlc input_fn dflags = do + ver <- io $ readIORef (llvmVersion dflags) + let lc_opts = getOpts dflags opt_lc opt_lvl = max 0 (min 2 $ optLevel dflags) rmodel | opt_PIC = "pic" | not opt_Static = "dynamic-no-pic" | otherwise = "static" + tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier + | dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + | otherwise = "--enable-tbaa=false" -- hidden debugging flag '-dno-llvm-mangler' to skip mangling let next_phase = case dopt Opt_NoLlvmMangler dflags of @@ -1356,6 +1368,7 @@ runPhase LlvmLlc input_fn dflags SysTools.FileOption "" input_fn, SysTools.Option "-o", SysTools.FileOption "" output_fn] ++ map SysTools.Option lc_opts + ++ [SysTools.Option tbaa] ++ map SysTools.Option fpOpts) return (next_phase, output_fn) @@ -1373,7 +1386,7 @@ runPhase LlvmLlc input_fn dflags else if (elem VFPv3D16 ext) then ["-mattr=+v7,+vfp3,+d16"] else [] - _ -> [] + _ -> [] ----------------------------------------------------------------------------- -- LlvmMangle phase diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 48830e1b99..ac4df37ac8 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -29,7 +29,7 @@ module DynFlags ( xopt_set, xopt_unset, DynFlags(..), - HasDynFlags(..), + HasDynFlags(..), ContainsDynFlags(..), RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, GhcMode(..), isOneShot, @@ -250,6 +250,8 @@ data DynFlag | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation | Opt_PedanticBottoms -- Be picky about how we treat bottom + | Opt_LlvmTBAA -- Use LLVM TBAA infastructure for improving AA + | Opt_RegLiveness -- Use the STG Reg liveness information -- Interface files | Opt_IgnoreInterfacePragmas @@ -346,6 +348,7 @@ data WarningFlag = | Opt_WarnAlternativeLayoutRuleTransitional | Opt_WarnUnsafe | Opt_WarnSafe + | Opt_WarnPointlessPragmas deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -404,6 +407,7 @@ data ExtensionFlag | Opt_RebindableSyntax | Opt_ConstraintKinds | Opt_PolyKinds -- Kind polymorphism + | Opt_DataKinds -- Datatype promotion | Opt_InstanceSigs | Opt_StandaloneDeriving @@ -585,12 +589,17 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String, -- | what kind of {-# SCC #-} to add automatically - profAuto :: ProfAuto + profAuto :: ProfAuto, + + llvmVersion :: IORef (Int) } class HasDynFlags m where getDynFlags :: m DynFlags +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + data ProfAuto = NoProfAuto -- ^ no SCC annotations added | ProfAutoAll -- ^ top-level and nested functions are annotated @@ -821,13 +830,15 @@ initDynFlags dflags = do refFilesToClean <- newIORef [] refDirsToClean <- newIORef Map.empty refGeneratedDumps <- newIORef Set.empty + refLlvmVersion <- newIORef 28 return dflags{ - ways = ways, - buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), - rtsBuildTag = mkBuildTag ways, - filesToClean = refFilesToClean, - dirsToClean = refDirsToClean, - generatedDumps = refGeneratedDumps + ways = ways, + buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), + rtsBuildTag = mkBuildTag ways, + filesToClean = refFilesToClean, + dirsToClean = refDirsToClean, + generatedDumps = refGeneratedDumps, + llvmVersion = refLlvmVersion } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -919,7 +930,8 @@ defaultDynFlags mySettings = extensions = [], extensionFlags = flattenExtensionFlags Nothing [], log_action = defaultLogAction, - profAuto = NoProfAuto + profAuto = NoProfAuto, + llvmVersion = panic "defaultDynFlags: No llvmVersion" } type LogAction = Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () @@ -1782,7 +1794,8 @@ fWarningFlags = [ ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ), ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ), ( "warn-unsafe", Opt_WarnUnsafe, setWarnUnsafe ), - ( "warn-safe", Opt_WarnSafe, setWarnSafe ) ] + ( "warn-safe", Opt_WarnSafe, setWarnSafe ), + ( "warn-pointless-pragmas", Opt_WarnPointlessPragmas, nop ) ] -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ fFlags :: [FlagSpec DynFlag] @@ -1823,6 +1836,8 @@ fFlags = [ ( "vectorise", Opt_Vectorise, nop ), ( "regs-graph", Opt_RegsGraph, nop ), ( "regs-iterative", Opt_RegsIterative, nop ), + ( "llvm-tbaa", Opt_LlvmTBAA, nop), + ( "reg-liveness", Opt_RegLiveness, nop), ( "gen-manifest", Opt_GenManifest, nop ), ( "embed-manifest", Opt_EmbedManifest, nop ), ( "ext-core", Opt_EmitExternalCore, nop ), @@ -1952,6 +1967,7 @@ xFlags = [ ( "RebindableSyntax", Opt_RebindableSyntax, nop ), ( "ConstraintKinds", Opt_ConstraintKinds, nop ), ( "PolyKinds", Opt_PolyKinds, nop ), + ( "DataKinds", Opt_DataKinds, nop ), ( "InstanceSigs", Opt_InstanceSigs, nop ), ( "MonoPatBinds", Opt_MonoPatBinds, \ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ), @@ -2039,8 +2055,6 @@ impliedFlags , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures -- all over the place - , (Opt_PolyKinds, turnOn, Opt_KindSignatures) - , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes) -- Record wild-cards implies field disambiguation @@ -2071,6 +2085,8 @@ optLevelFlags , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) , ([2], Opt_RegsGraph) + , ([0,1,2], Opt_LlvmTBAA) + , ([0,1,2], Opt_RegLiveness) -- , ([2], Opt_StaticArgumentTransformation) -- Max writes: I think it's probably best not to enable SAT with -O2 for the @@ -2104,7 +2120,8 @@ standardWarnings Opt_WarnLazyUnliftedBindings, Opt_WarnDodgyForeignImports, Opt_WarnWrongDoBind, - Opt_WarnAlternativeLayoutRuleTransitional + Opt_WarnAlternativeLayoutRuleTransitional, + Opt_WarnPointlessPragmas ] minusWOpts :: [WarningFlag] diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 3ac3a473a3..1417dad061 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -46,8 +46,8 @@ import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef ) import System.Directory import System.FilePath import Control.Monad -import System.Time ( ClockTime ) import Data.List ( partition ) +import Data.Time type FileExt = String -- Filename extension @@ -528,7 +528,7 @@ findObjectLinkableMaybe mod locn -- Make an object linkable when we know the object file exists, and we know -- its modification time. -findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable +findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn]) -- We used to look for _stub.o files here, but that was a bug (#706) -- Now GHC merges the stub.o into the main .o (#3687) diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 6c31e2e1bf..d3a8bb11de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -300,11 +300,11 @@ import Lexer import System.Directory ( doesFileExist, getCurrentDirectory ) import Data.Maybe import Data.List ( find ) +import Data.Time import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) import Control.Monad import System.Exit ( exitWith, ExitCode(..) ) -import System.Time ( getClockTime ) import Exception import Data.IORef import System.FilePath @@ -812,7 +812,7 @@ compileToCore fn = do compileCoreToObj :: GhcMonad m => Bool -> CoreModule -> m () compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do dflags <- getSessionDynFlags - currentTime <- liftIO $ getClockTime + currentTime <- liftIO $ getCurrentTime cwd <- liftIO $ getCurrentDirectory modLocation <- liftIO $ mkHiOnlyModLocation dflags (hiSuf dflags) cwd ((moduleNameSlashes . moduleName) mName) diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 3db920553e..a2fb9edf16 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -62,15 +62,15 @@ import UniqFM import qualified Data.Map as Map import qualified FiniteMap as Map( insertListWith) -import System.Directory ( doesFileExist, getModificationTime ) +import System.Directory import System.IO ( fixIO ) import System.IO.Error ( isDoesNotExistError ) -import System.Time ( ClockTime ) import System.FilePath import Control.Monad import Data.Maybe import Data.List import qualified Data.List as List +import Data.Time -- ----------------------------------------------------------------------------- -- Loading the program @@ -1200,7 +1200,7 @@ summariseFile -> FilePath -- source file name -> Maybe Phase -- start phase -> Bool -- object code allowed? - -> Maybe (StringBuffer,ClockTime) + -> Maybe (StringBuffer,UTCTime) -> IO ModSummary summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf @@ -1214,10 +1214,10 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf -- return the cached summary if the source didn't change src_timestamp <- case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file + Nothing -> liftIO $ getModificationUTCTime file -- The file exists; we checked in getRootSummary above. -- If it gets removed subsequently, then this - -- getModificationTime may fail, but that's the right + -- getModificationUTCTime may fail, but that's the right -- behaviour. if ms_hs_date old_summary == src_timestamp @@ -1251,7 +1251,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf src_timestamp <- case maybe_buf of Just (_,t) -> return t - Nothing -> liftIO $ getModificationTime file + Nothing -> liftIO $ getModificationUTCTime file -- getMofificationTime may fail -- when the user asks to load a source file by name, we only @@ -1285,7 +1285,7 @@ summariseModule -> IsBootInterface -- True <=> a {-# SOURCE #-} import -> Located ModuleName -- Imported module to be summarised -> Bool -- object code allowed? - -> Maybe (StringBuffer, ClockTime) + -> Maybe (StringBuffer, UTCTime) -> [ModuleName] -- Modules to exclude -> IO (Maybe ModSummary) -- Its new summary @@ -1306,7 +1306,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) case maybe_buf of Just (_,t) -> check_timestamp old_summary location src_fn t Nothing -> do - m <- tryIO (getModificationTime src_fn) + m <- tryIO (getModificationUTCTime src_fn) case m of Right t -> check_timestamp old_summary location src_fn t Left e | isDoesNotExistError e -> find_it @@ -1398,7 +1398,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) ms_obj_date = obj_timestamp })) -getObjTimestamp :: ModLocation -> Bool -> IO (Maybe ClockTime) +getObjTimestamp :: ModLocation -> Bool -> IO (Maybe UTCTime) getObjTimestamp location is_boot = if is_boot then return Nothing else modificationTimeIfExists (ml_obj_file location) @@ -1407,7 +1407,7 @@ getObjTimestamp location is_boot preprocessFile :: HscEnv -> FilePath -> Maybe Phase -- ^ Starting phase - -> Maybe (StringBuffer,ClockTime) + -> Maybe (StringBuffer,UTCTime) -> IO (DynFlags, FilePath, StringBuffer) preprocessFile hsc_env src_fn mb_phase Nothing = do diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index b6bf938332..3224acf0fe 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -92,7 +92,7 @@ module HscTypes ( -- * Vectorisation information VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, - noIfaceVectInfo, + noIfaceVectInfo, isNoIfaceVectInfo, -- * Safe Haskell information hscGetSafeInf, hscSetSafeInf, @@ -164,11 +164,11 @@ import Control.Monad ( mplus, guard, liftM, when ) import Data.Array ( Array, array ) import Data.IORef import Data.Map ( Map ) +import Data.Time import Data.Word import Data.Typeable ( Typeable ) import Exception import System.FilePath -import System.Time ( ClockTime ) -- ----------------------------------------------------------------------------- -- Source Errors @@ -356,7 +356,7 @@ data Target = Target { targetId :: TargetId, -- ^ module or filename targetAllowObjCode :: Bool, -- ^ object code allowed? - targetContents :: Maybe (StringBuffer,ClockTime) + targetContents :: Maybe (StringBuffer,UTCTime) -- ^ in-memory text buffer? } @@ -696,8 +696,8 @@ data ModIface mi_insts :: [IfaceClsInst], -- ^ Sorted class instance mi_fam_insts :: [IfaceFamInst], -- ^ Sorted family instances mi_rules :: [IfaceRule], -- ^ Sorted rules - mi_orphan_hash :: !Fingerprint, -- ^ Hash for orphan rules and class - -- and family instances combined + mi_orphan_hash :: !Fingerprint, -- ^ Hash for orphan rules, class and family + -- instances, and vectorise pragmas combined mi_vect_info :: !IfaceVectInfo, -- ^ Vectorisation information @@ -1566,6 +1566,8 @@ lookupFixity env n = case lookupNameEnv env n of -- -- * A transformation rule in a module other than the one defining -- the function in the head of the rule +-- +-- * A vectorisation pragma type WhetherHasOrphans = Bool -- | Does this module define family instances? @@ -1632,7 +1634,7 @@ data Usage } -- ^ Module from the current package | UsageFile { usg_file_path :: FilePath, - usg_mtime :: ClockTime + usg_mtime :: UTCTime -- ^ External file dependency. From a CPP #include or TH addDependentFile. Should be absolute. } deriving( Eq ) @@ -1803,8 +1805,8 @@ data ModSummary ms_mod :: Module, -- ^ Identity of the module ms_hsc_src :: HscSource, -- ^ The module source either plain Haskell, hs-boot or external core ms_location :: ModLocation, -- ^ Location of the various files belonging to the module - ms_hs_date :: ClockTime, -- ^ Timestamp of source file - ms_obj_date :: Maybe ClockTime, -- ^ Timestamp of object, if we have one + ms_hs_date :: UTCTime, -- ^ Timestamp of source file + ms_obj_date :: Maybe UTCTime, -- ^ Timestamp of object, if we have one ms_srcimps :: [Located (ImportDecl RdrName)], -- ^ Source imports of the module ms_textual_imps :: [Located (ImportDecl RdrName)], -- ^ Non-source imports of the module from the module *text* ms_hspp_file :: FilePath, -- ^ Filename of preprocessed source file @@ -2009,6 +2011,10 @@ concatVectInfo = foldr plusVectInfo noVectInfo noIfaceVectInfo :: IfaceVectInfo noIfaceVectInfo = IfaceVectInfo [] [] [] [] [] +isNoIfaceVectInfo :: IfaceVectInfo -> Bool +isNoIfaceVectInfo (IfaceVectInfo l1 l2 l3 l4 l5) + = null l1 && null l2 && null l3 && null l4 && null l5 + instance Outputable VectInfo where ppr info = vcat [ ptext (sLit "variables :") <+> ppr (vectInfoVar info) @@ -2100,7 +2106,7 @@ stuff is the *dynamic* linker, and isn't present in a stage-1 compiler \begin{code} -- | Information we can use to dynamically link modules into the compiler data Linkable = LM { - linkableTime :: ClockTime, -- ^ Time at which this linkable was built + linkableTime :: UTCTime, -- ^ Time at which this linkable was built -- (i.e. when the bytecodes were produced, -- or the mod date on the files) linkableModule :: Module, -- ^ The linkable module itself diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 5e2a9375a0..34afd5ca0e 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -513,6 +513,7 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars tidy_var_v = lookup_var var_v , isExportedId tidy_var , isExportedId tidy_var_v + , isDataConWorkId var || not (isImplicitId var) ] tidy_scalarVars = mkVarSet [ lookup_var var diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs index b3d8d63fbd..861fffb7f6 100644 --- a/compiler/parser/LexCore.hs +++ b/compiler/parser/LexCore.hs @@ -1,11 +1,3 @@ - -{-# 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 LexCore where import ParserCoreUtils @@ -15,39 +7,39 @@ import Numeric isNameChar :: Char -> Bool isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') - || (c == '$') || (c == '-') || (c == '.') + || (c == '$') || (c == '-') || (c == '.') isKeywordChar :: Char -> Bool -isKeywordChar c = isAlpha c || (c == '_') +isKeywordChar c = isAlpha c || (c == '_') -lexer :: (Token -> P a) -> P a -lexer cont [] = cont TKEOF [] -lexer cont ('\n':cs) = \line -> lexer cont cs (line+1) +lexer :: (Token -> P a) -> P a +lexer cont [] = cont TKEOF [] +lexer cont ('\n':cs) = \line -> lexer cont cs (line+1) lexer cont ('-':'>':cs) = cont TKrarrow cs -lexer cont (c:cs) - | isSpace c = lexer cont cs +lexer cont (c:cs) + | isSpace c = lexer cont cs | isLower c || (c == '_') = lexName cont TKname (c:cs) - | isUpper c = lexName cont TKcname (c:cs) + | isUpper c = lexName cont TKcname (c:cs) | isDigit c || (c == '-') = lexNum cont (c:cs) -lexer cont ('%':cs) = lexKeyword cont cs -lexer cont ('\'':cs) = lexChar cont cs -lexer cont ('\"':cs) = lexString [] cont cs -lexer cont ('#':cs) = cont TKhash cs -lexer cont ('(':cs) = cont TKoparen cs -lexer cont (')':cs) = cont TKcparen cs -lexer cont ('{':cs) = cont TKobrace cs -lexer cont ('}':cs) = cont TKcbrace cs +lexer cont ('%':cs) = lexKeyword cont cs +lexer cont ('\'':cs) = lexChar cont cs +lexer cont ('\"':cs) = lexString [] cont cs +lexer cont ('#':cs) = cont TKhash cs +lexer cont ('(':cs) = cont TKoparen cs +lexer cont (')':cs) = cont TKcparen cs +lexer cont ('{':cs) = cont TKobrace cs +lexer cont ('}':cs) = cont TKcbrace cs lexer cont ('=':cs) = cont TKeq cs lexer cont (':':'=':':':cs) = cont TKcoloneqcolon cs lexer cont (':':':':cs) = cont TKcoloncolon cs -lexer cont ('*':cs) = cont TKstar cs -lexer cont ('.':cs) = cont TKdot cs +lexer cont ('*':cs) = cont TKstar cs +lexer cont ('.':cs) = cont TKdot cs lexer cont ('\\':cs) = cont TKlambda cs -lexer cont ('@':cs) = cont TKat cs -lexer cont ('?':cs) = cont TKquestion cs -lexer cont (';':cs) = cont TKsemicolon cs +lexer cont ('@':cs) = cont TKat cs +lexer cont ('?':cs) = cont TKquestion cs +lexer cont (';':cs) = cont TKsemicolon cs -- 20060420 GHC spits out constructors with colon in them nowadays. jds -- 20061103 but it's easier to parse if we split on the colon, and treat them -- as several tokens @@ -68,7 +60,7 @@ lexChar _ cs = panic ("lexChar: " ++ show cs) lexString :: String -> (Token -> [Char] -> Int -> ParseResult a) -> String -> Int -> ParseResult a -lexString s cont ('\\':'x':h1:h0:cs) +lexString s cont ('\\':'x':h1:h0:cs) | isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs lexString _ _ ('\\':_) = failP "invalid string character" ['\\'] lexString _ _ ('\'':_) = failP "invalid string character" ['\''] @@ -86,14 +78,14 @@ lexNum :: (Token -> String -> a) -> String -> a lexNum cont cs = case cs of ('-':cs) -> f (-1) cs - _ -> f 1 cs - where f sgn cs = + _ -> f 1 cs + where f sgn cs = case span isDigit cs of - (digits,'.':c:rest) - | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest' - where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest)) - -- When reading a floating-point number, which is - -- a bit complicated, use the standard library function + (digits,'.':c:rest) + | isDigit c -> cont (TKrational (fromInteger sgn * r)) rest' + where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest)) + -- When reading a floating-point number, which is + -- a bit complicated, use the standard library function -- "readFloat" (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest @@ -103,21 +95,21 @@ lexName cont cstr cs = cont (cstr name) rest lexKeyword :: (Token -> [Char] -> Int -> ParseResult a) -> String -> Int -> ParseResult a -lexKeyword cont cs = +lexKeyword cont cs = case span isKeywordChar cs of ("module",rest) -> cont TKmodule rest ("data",rest) -> cont TKdata rest ("newtype",rest) -> cont TKnewtype rest - ("forall",rest) -> cont TKforall rest - ("rec",rest) -> cont TKrec rest - ("let",rest) -> cont TKlet rest - ("in",rest) -> cont TKin rest - ("case",rest) -> cont TKcase rest - ("of",rest) -> cont TKof rest - ("cast",rest) -> cont TKcast rest - ("note",rest) -> cont TKnote rest + ("forall",rest) -> cont TKforall rest + ("rec",rest) -> cont TKrec rest + ("let",rest) -> cont TKlet rest + ("in",rest) -> cont TKin rest + ("case",rest) -> cont TKcase rest + ("of",rest) -> cont TKof rest + ("cast",rest) -> cont TKcast rest + ("note",rest) -> cont TKnote rest ("external",rest) -> cont TKexternal rest ("local",rest) -> cont TKlocal rest ("_",rest) -> cont TKwild rest - _ -> failP "invalid keyword" ('%':cs) + _ -> failP "invalid keyword" ('%':cs) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index e0e97fed4a..6e74cfbc4a 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -509,8 +509,6 @@ data Token | ITocurly -- special symbols | ITccurly - | ITocurlybar -- {|, for type applications - | ITccurlybar -- |}, for type applications | ITvocurly | ITvccurly | ITobrack diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 9803650842..b664861c44 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -294,8 +294,6 @@ incorrect. '{' { L _ ITocurly } -- special symbols '}' { L _ ITccurly } - '{|' { L _ ITocurlybar } - '|}' { L _ ITccurlybar } vocurly { L _ ITvocurly } -- virtual open curly (from layout) vccurly { L _ ITvccurly } -- virtual close curly (from layout) '[' { L _ ITobrack } @@ -1432,14 +1430,6 @@ aexp1 :: { LHsExpr RdrName } ; checkRecordSyntax (LL r) }} | aexp2 { $1 } --- Here was the syntax for type applications that I was planning --- but there are difficulties (e.g. what order for type args) --- so it's not enabled yet. --- But this case *is* used for the left hand side of a generic definition, --- which is parsed as an expression before being munged into a pattern - | qcname '{|' type '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1))) - (sL (getLoc $3) (HsType $3)) } - aexp2 :: { LHsExpr RdrName } : ipvar { L1 (HsIPVar $! unLoc $1) } | qcname { L1 (HsVar $! unLoc $1) } @@ -1591,16 +1581,17 @@ squals :: { Located [LStmt RdrName] } -- In reverse order, because the last -- | '{|' pquals '|}' { L1 [$2] } --- It is possible to enable bracketing (associating) qualifier lists by uncommenting the lines with {| |} --- above. Due to a lack of consensus on the syntax, this feature is not being used until we get user --- demand. +-- It is possible to enable bracketing (associating) qualifier lists +-- by uncommenting the lines with {| |} above. Due to a lack of +-- consensus on the syntax, this feature is not being used until we +-- get user demand. transformqual :: { Located ([LStmt RdrName] -> Stmt RdrName) } -- Function is applied to a list of stmts *in order* - : 'then' exp { LL $ \leftStmts -> (mkTransformStmt leftStmts $2) } - | 'then' exp 'by' exp { LL $ \leftStmts -> (mkTransformByStmt leftStmts $2 $4) } - | 'then' 'group' 'using' exp { LL $ \leftStmts -> (mkGroupUsingStmt leftStmts $4) } - | 'then' 'group' 'by' exp 'using' exp { LL $ \leftStmts -> (mkGroupByUsingStmt leftStmts $4 $6) } + : 'then' exp { LL $ \ss -> (mkTransformStmt ss $2) } + | 'then' exp 'by' exp { LL $ \ss -> (mkTransformByStmt ss $2 $4) } + | 'then' 'group' 'using' exp { LL $ \ss -> (mkGroupUsingStmt ss $4) } + | 'then' 'group' 'by' exp 'using' exp { LL $ \ss -> (mkGroupByUsingStmt ss $4 $6) } -- Note that 'group' is a special_id, which means that you can enable -- TransformListComp while still using Data.List.group. However, this diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 8daa6fa3c7..131c86bda2 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -870,10 +870,10 @@ quotRemIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotRemInteger") quo divModIntegerName = varQual gHC_INTEGER_TYPE (fsLit "divModInteger") divModIntegerIdKey quotIntegerName = varQual gHC_INTEGER_TYPE (fsLit "quotInteger") quotIntegerIdKey remIntegerName = varQual gHC_INTEGER_TYPE (fsLit "remInteger") remIntegerIdKey -floatFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "floatFromIntegerName") floatFromIntegerIdKey -doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromIntegerName") doubleFromIntegerIdKey -encodeFloatIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatIntegerName") encodeFloatIntegerIdKey -encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleIntegerName") encodeDoubleIntegerIdKey +floatFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "floatFromInteger") floatFromIntegerIdKey +doubleFromIntegerName = varQual gHC_INTEGER_TYPE (fsLit "doubleFromInteger") doubleFromIntegerIdKey +encodeFloatIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeFloatInteger") encodeFloatIntegerIdKey +encodeDoubleIntegerName = varQual gHC_INTEGER_TYPE (fsLit "encodeDoubleInteger") encodeDoubleIntegerIdKey gcdIntegerName = varQual gHC_INTEGER_TYPE (fsLit "gcdInteger") gcdIntegerIdKey lcmIntegerName = varQual gHC_INTEGER_TYPE (fsLit "lcmInteger") lcmIntegerIdKey andIntegerName = varQual gHC_INTEGER_TYPE (fsLit "andInteger") andIntegerIdKey diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index d57d1f926e..39bee1fb9d 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -12,7 +12,8 @@ module PrimOp ( tagToEnumKey, primOpOutOfLine, primOpCodeSize, - primOpOkForSpeculation, primOpIsCheap, + primOpOkForSpeculation, primOpOkForSideEffects, + primOpIsCheap, getPrimOpResultInfo, PrimOpResultInfo(..), @@ -307,77 +308,93 @@ primOpOutOfLine :: PrimOp -> Bool Note [PrimOp can_fail and has_side_effects] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * A primop that is neither can_fail nor has_side_effects can be - executed speculatively, any number of times +Both can_fail and has_side_effects mean that the primop has +some effect that is not captured entirely by its result value. + + ---------- has_side_effects --------------------- + Has some imperative side effect, perhaps on the world (I/O), + or perhaps on some mutable data structure (writeIORef). + Generally speaking all such primops have a type like + State -> input -> (State, output) + so the state token guarantees ordering, and also ensures + that the primop is executed even if 'output' is discarded. + + ---------- can_fail ---------------------------- + Can fail with a seg-fault or divide-by-zero error on some elements + of its input domain. Main examples: + division (fails on zero demoninator + array indexing (fails if the index is out of bounds) + However (ASSUMPTION), these can_fail primops are ALWAYS surrounded + with a test that checks for the bad cases. + +Consequences: + +* You can discard a can_fail primop, or float it _inwards_. + But you cannot float it _outwards_, lest you escape the + dynamic scope of the test. Example: + case d ># 0# of + True -> case x /# d of r -> r +# 1 + False -> 0 + Here we must not float the case outwards to give + case x/# d of r -> + case d ># 0# of + True -> r +# 1 + False -> 0 + +* I believe that exactly the same rules apply to a has_side_effects + primop; you can discard it (remember, the state token will keep + it alive if necessary), or float it in, but not float it out. + + Example of the latter + if blah then let! s1 = writeMutVar s0 v True in s1 + else s0 + Notice that s0 is mentioned in both branches of the 'if', but + only one of these two will actually be consumed. But if we + float out to + let! s1 = writeMutVar s0 v True + in if blah then s1 else s0 + the writeMutVar will be performed in both branches, which is + utterly wrong. + +* You cannot duplicate a has_side_effect primop. You might wonder + how this can occur given the state token threading, but just look + at Control.Monad.ST.Lazy.Imp.strictToLazy! We get something like + this + p = case readMutVar# s v of + (# s', r #) -> (S# s', r) + s' = case p of (s', r) -> s' + r = case p of (s', r) -> r + + (All these bindings are boxed.) If we inline p at its two call + sites, we get a catastrophe: because the read is performed once when + s' is demanded, and once when 'r' is demanded, which may be much + later. Utterly wrong. Trac #3207 is real example of this happening. + + However, it's fine to duplicate a can_fail primop. That is + the difference between can_fail and has_side_effects. + + can_fail has_side_effects +Discard YES YES +Float in YES YES +Float out NO NO +Duplicate YES NO + +How do we achieve these effects? - * A primop that is marked can_fail cannot be executed speculatively, - (becuase the might provoke the failure), but it can be repeated. - Why would you want to do that? Perhaps it might enable some - eta-expansion, if you can prove that the lambda is definitely - applied at least once. I guess we don't currently do that. +Note [primOpOkForSpeculation] + * The "no-float-out" thing is achieved by ensuring that we never + let-bind a can_fail or has_side_effects primop. The RHS of a + let-binding (which can float in and out freely) satisfies + exprOkForSpeculation. And exprOkForSpeculation is false of + can_fail and no_side_effect. - * A primop that is marked has_side_effects can be neither speculated - nor repeated; it must be executed exactly the right number of - times. + * So can_fail and no_side_effect primops will appear only as the + scrutinees of cases, and that's why the FloatIn pass is capable + of floating case bindings inwards. -So has_side_effects implies can_fail. We don't currently exploit -the case of primops that can_fail but do not have_side_effects. + * The no-duplicate thing is done via primOpIsCheap, by making + has_side_effects things (very very very) not-cheap! -Note [primOpOkForSpeculation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Sometimes we may choose to execute a PrimOp even though it isn't -certain that its result will be required; ie execute them -``speculatively''. The same thing as ``cheap eagerness.'' Usually -this is OK, because PrimOps are usually cheap, but it isn't OK for - * PrimOps that are expensive - * PrimOps which can fail - * PrimOps that have side effects - -Ok-for-speculation also means that it's ok *not* to execute the -primop. For example - case op a b of - r -> 3 -Here the result is not used, so we can discard the primop. Anything -that has side effects mustn't be dicarded in this way, of course! - -See also @primOpIsCheap@ (below). - -Note [primOpHasSideEffects] -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some primops have side-effects and so, for example, must not be -duplicated. - -This predicate means a little more than just "modifies the state of -the world". What it really means is "it cosumes the state on its -input". To see what this means, consider - - let - t = case readMutVar# v s0 of (# s1, x #) -> (S# s1, x) - y = case t of (s,x) -> x - in - ... y ... y ... - -Now, this is part of an ST or IO thread, so we are guaranteed by -construction that the program uses the state in a single-threaded way. -Whenever the state resulting from the readMutVar# is demanded, the -readMutVar# will be performed, and it will be ordered correctly with -respect to other operations in the monad. - -But there's another way this could go wrong: GHC can inline t into y, -and inline y. Then although the original readMutVar# will still be -correctly ordered with respect to the other operations, there will be -one or more extra readMutVar#s performed later, possibly out-of-order. -This really happened; see #3207. - -The property we need to capture about readMutVar# is that it consumes -the State# value on its input. We must retain the linearity of the -State#. - -Our fix for this is to declare any primop that must be used linearly -as having side-effects. When primOpHasSideEffects is True, -primOpOkForSpeculation will be False, and hence primOpIsCheap will -also be False, and applications of the primop will never be -duplicated. \begin{code} primOpHasSideEffects :: PrimOp -> Bool @@ -387,15 +404,19 @@ primOpCanFail :: PrimOp -> Bool #include "primop-can-fail.hs-incl" primOpOkForSpeculation :: PrimOp -> Bool - -- See Note [primOpOkForSpeculation] + -- See Note [primOpOkForSpeculation and primOpOkForFloatOut] -- See comments with CoreUtils.exprOkForSpeculation primOpOkForSpeculation op = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op) + +primOpOkForSideEffects :: PrimOp -> Bool +primOpOkForSideEffects op + = not (primOpHasSideEffects op) \end{code} -primOpIsCheap -~~~~~~~~~~~~~ +Note [primOpIsCheap] +~~~~~~~~~~~~~~~~~~~~ @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK WARNING), we just borrow some other predicates for a what-should-be-good-enough test. "Cheap" means willing to call it more diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 5047b3cb63..48dd76873a 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1481,7 +1481,10 @@ primop RaiseOp "raise#" GenPrimOp -- one kind of bottom into another, as it is allowed to do in pure code. -- -- But we *do* want to know that it returns bottom after --- being applied to two arguments +-- being applied to two arguments, so that this function is strict in y +-- f x y | x>0 = raiseIO blah +-- | y>0 = return 1 +-- | otherwise = return 2 primop RaiseIOOp "raiseIO#" GenPrimOp a -> State# RealWorld -> (# State# RealWorld, b #) diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index a4bf1f2d69..bd424e87b8 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -462,17 +462,17 @@ lookupPromotedOccRn rdr_name Nothing -> do { -- Maybe it's the name of a *data* constructor - poly_kinds <- xoptM Opt_PolyKinds + data_kinds <- xoptM Opt_DataKinds ; mb_demoted_name <- case demoteRdrName rdr_name of Just demoted_rdr -> lookupOccRn_maybe demoted_rdr Nothing -> return Nothing ; case mb_demoted_name of Nothing -> unboundName WL_Any rdr_name Just demoted_name - | poly_kinds -> return demoted_name + | data_kinds -> return demoted_name | otherwise -> unboundNameX WL_Any rdr_name suggest_pk }}} where - suggest_pk = ptext (sLit "A data constructor of that name is in scope; did you mean -XPolyKinds?") + suggest_pk = ptext (sLit "A data constructor of that name is in scope; did you mean -XDataKinds?") \end{code} Note [Demotion] @@ -1112,7 +1112,7 @@ checkShadowedOccs (global_env,local_env) loc_occs -- Returns False for record selectors that are shadowed, when -- punning or wild-cards are on (cf Trac #2723) is_shadowed_gre gre@(GRE { gre_par = ParentIs _ }) - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags) then do { is_fld <- is_rec_fld gre; return (not is_fld) } else return True } @@ -1437,7 +1437,7 @@ kindSigErr thing polyKindsErr :: Outputable a => a -> SDoc polyKindsErr thing = hang (ptext (sLit "Illegal kind:") <+> quotes (ppr thing)) - 2 (ptext (sLit "Perhaps you intended to use -XPolyKinds")) + 2 (ptext (sLit "Perhaps you intended to use -XDataKinds")) badQualBndrErr :: RdrName -> SDoc diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 04877331d0..7caae61027 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -1239,7 +1239,7 @@ checkStmt :: HsStmtContext Name -> LStmt RdrName -> RnM () checkStmt ctxt (L _ stmt) - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; case okStmt dflags ctxt stmt of Nothing -> return () Just extra -> addErr (msg $$ extra) } diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 1f9041e473..68e6d027e6 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -200,7 +200,7 @@ rnImportDecl this_mod -- and indeed we shouldn't do it here because the existence of -- the non-boot module depends on the compilation order, which -- is not deterministic. The hs-boot test can show this up. - dflags <- getDOpts + dflags <- getDynFlags warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags)) (warnRedundantSourceImport imp_mod_name) when (mod_safe && not (safeImportsOn dflags)) $ @@ -964,7 +964,7 @@ rnExports explicit_mod exports -- written "module Main where ..." -- Reason: don't want to complain about 'main' not in scope -- in interactive mode - ; dflags <- getDOpts + ; dflags <- getDynFlags ; let real_exports | explicit_mod = exports | ghcLink dflags == LinkInMemory = Nothing diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 197f2b2554..175b9a7ba4 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -682,7 +682,7 @@ rnHsVectDecl (HsVectClassOut _) = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectClassOut'" rnHsVectDecl (HsVectInstIn instTy) = do { instTy' <- rnLHsInstType (text "In a VECTORISE pragma") instTy - ; return (HsVectInstIn instTy', emptyFVs) + ; return (HsVectInstIn instTy', extractHsTyNames instTy') } rnHsVectDecl (HsVectInstOut _) = panic "RnSource.rnHsVectDecl: Unexpected 'HsVectInstOut'" @@ -749,7 +749,7 @@ rnTyClDecls :: [Name] -> [[LTyClDecl RdrName]] -- Rename the declarations and do depedency analysis on them rnTyClDecls extra_deps tycl_ds = do { ds_w_fvs <- mapM (wrapLocFstM (rnTyClDecl Nothing)) (concat tycl_ds) - ; thisPkg <- fmap thisPackage getDOpts + ; thisPkg <- fmap thisPackage getDynFlags ; let add_boot_deps :: FreeVars -> FreeVars -- See Note [Extra dependencies from .hs-boot files] add_boot_deps fvs | any (isInPackage thisPkg) (nameSetToList fvs) diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index 936f38f55b..c6c64e8b33 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -196,8 +196,8 @@ rnHsTyKi isType doc (HsFunTy ty1 ty2) = do else return (HsFunTy ty1' ty2') rnHsTyKi isType doc listTy@(HsListTy ty) = do - poly_kinds <- xoptM Opt_PolyKinds - unless (poly_kinds || isType) (addErr (polyKindsErr listTy)) + data_kinds <- xoptM Opt_DataKinds + unless (data_kinds || isType) (addErr (polyKindsErr listTy)) ty' <- rnLHsTyKi isType doc ty return (HsListTy ty') @@ -216,8 +216,8 @@ rnHsTyKi isType doc (HsPArrTy ty) = ASSERT ( isType ) do -- Unboxed tuples are allowed to have poly-typed arguments. These -- sometimes crop up as a result of CPR worker-wrappering dictionaries. rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) = do - poly_kinds <- xoptM Opt_PolyKinds - unless (poly_kinds || isType) (addErr (polyKindsErr tupleTy)) + data_kinds <- xoptM Opt_DataKinds + unless (data_kinds || isType) (addErr (polyKindsErr tupleTy)) tys' <- mapM (rnLHsTyKi isType doc) tys return (HsTupleTy tup_con tys') diff --git a/compiler/simplCore/FloatIn.lhs b/compiler/simplCore/FloatIn.lhs index 6745fda8cb..0601d7b7bf 100644 --- a/compiler/simplCore/FloatIn.lhs +++ b/compiler/simplCore/FloatIn.lhs @@ -24,7 +24,8 @@ module FloatIn ( floatInwards ) where #include "HsVersions.h" import CoreSyn -import CoreUtils ( exprIsHNF, exprIsDupable ) +import MkCore +import CoreUtils ( exprIsDupable, exprIsExpandable, exprOkForSideEffects ) import CoreFVs ( CoreExprWithFVs, freeVars, freeVarsOf, idRuleAndUnfoldingVars ) import Id ( isOneShotBndr, idType ) import Var @@ -119,26 +120,28 @@ the closure for a is not built. %************************************************************************ \begin{code} -type FreeVarsSet = IdSet +type FreeVarSet = IdSet +type BoundVarSet = IdSet -type FloatingBinds = [(CoreBind, FreeVarsSet)] - -- In reverse dependency order (innermost binder first) - - -- The FreeVarsSet is the free variables of the binding. In the case +data FloatInBind = FB BoundVarSet FreeVarSet FloatBind + -- The FreeVarSet is the free variables of the binding. In the case -- of recursive bindings, the set doesn't include the bound -- variables. -fiExpr :: FloatingBinds -- Binds we're trying to drop +type FloatInBinds = [FloatInBind] + -- In reverse dependency order (innermost binder first) + +fiExpr :: FloatInBinds -- Binds we're trying to drop -- as far "inwards" as possible -> CoreExprWithFVs -- Input expr -> CoreExpr -- Result fiExpr to_drop (_, AnnLit lit) = ASSERT( null to_drop ) Lit lit fiExpr to_drop (_, AnnType ty) = ASSERT( null to_drop ) Type ty -fiExpr to_drop (_, AnnVar v) = mkCoLets' to_drop (Var v) -fiExpr to_drop (_, AnnCoercion co) = mkCoLets' to_drop (Coercion co) +fiExpr to_drop (_, AnnVar v) = wrapFloats to_drop (Var v) +fiExpr to_drop (_, AnnCoercion co) = wrapFloats to_drop (Coercion co) fiExpr to_drop (_, AnnCast expr (fvs_co, co)) - = mkCoLets' (drop_here ++ co_drop) $ + = wrapFloats (drop_here ++ co_drop) $ Cast (fiExpr e_drop expr) co where [drop_here, e_drop, co_drop] = sepBindsByDropPoint False [freeVarsOf expr, fvs_co] to_drop @@ -149,10 +152,16 @@ need to get at all the arguments. The next simplifier run will pull out any silly ones. \begin{code} -fiExpr to_drop (_,AnnApp fun arg) - = mkCoLets' drop_here (App (fiExpr fun_drop fun) (fiExpr arg_drop arg)) +fiExpr to_drop (_,AnnApp fun arg@(arg_fvs, ann_arg)) + | noFloatIntoRhs ann_arg = wrapFloats drop_here $ wrapFloats arg_drop $ + App (fiExpr fun_drop fun) (fiExpr [] arg) + -- It's inconvenient to test for an unlifted arg here, + -- and it really doesn't matter if we float into one + | otherwise = wrapFloats drop_here $ + App (fiExpr fun_drop fun) (fiExpr arg_drop arg) where - [drop_here, fun_drop, arg_drop] = sepBindsByDropPoint False [freeVarsOf fun, freeVarsOf arg] to_drop + [drop_here, fun_drop, arg_drop] + = sepBindsByDropPoint False [freeVarsOf fun, arg_fvs] to_drop \end{code} Note [Floating in past a lambda group] @@ -199,7 +208,7 @@ fiExpr to_drop lam@(_, AnnLam _ _) = mkLams bndrs (fiExpr to_drop body) | otherwise -- Dump it all here - = mkCoLets' to_drop (mkLams bndrs (fiExpr [] body)) + = wrapFloats to_drop (mkLams bndrs (fiExpr [] body)) where (bndrs, body) = collectAnnBndrs lam @@ -220,7 +229,7 @@ We don't float lets inwards past an SCC. fiExpr to_drop (_, AnnTick tickish expr) | tickishScoped tickish = -- Wimp out for now - we could push values in - mkCoLets' to_drop (Tick tickish (fiExpr [] expr)) + wrapFloats to_drop (Tick tickish (fiExpr [] expr)) | otherwise = Tick tickish (fiExpr to_drop expr) @@ -266,7 +275,7 @@ can't have unboxed bindings. So we make "extra_fvs" which is the rhs_fvs of such bindings, and arrange to dump bindings that bind extra_fvs before the entire let. -Note [extra_fvs (s): free variables of rules] +Note [extra_fvs (2): free variables of rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider let x{rule mentioning y} = rhs in body @@ -280,13 +289,13 @@ idFreeVars. fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body) = fiExpr new_to_drop body where - body_fvs = freeVarsOf body + body_fvs = freeVarsOf body `delVarSet` id rule_fvs = idRuleAndUnfoldingVars id -- See Note [extra_fvs (2): free variables of rules] extra_fvs | noFloatIntoRhs ann_rhs || isUnLiftedType (idType id) = rule_fvs `unionVarSet` rhs_fvs | otherwise = rule_fvs - -- See Note [extra_fvs (2): avoid floating into RHS] + -- See Note [extra_fvs (1): avoid floating into RHS] -- No point in floating in only to float straight out again -- Ditto ok-for-speculation unlifted RHSs @@ -294,7 +303,8 @@ fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body) = sepBindsByDropPoint False [extra_fvs, rhs_fvs, body_fvs] to_drop new_to_drop = body_binds ++ -- the bindings used only in the body - [(NonRec id rhs', rhs_fvs')] ++ -- the new binding itself + [FB (unitVarSet id) rhs_fvs' + (FloatLet (NonRec id rhs'))] ++ -- the new binding itself extra_binds ++ -- bindings from extra_fvs shared_binds -- the bindings used both in rhs and body @@ -308,7 +318,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body) where (ids, rhss) = unzip bindings rhss_fvs = map freeVarsOf rhss - body_fvs = freeVarsOf body + body_fvs = freeVarsOf body -- See Note [extra_fvs (1,2)] rule_fvs = foldr (unionVarSet . idRuleAndUnfoldingVars) emptyVarSet ids @@ -320,7 +330,8 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body) = sepBindsByDropPoint False (extra_fvs:body_fvs:rhss_fvs) to_drop new_to_drop = body_binds ++ -- the bindings used only in the body - [(Rec (fi_bind rhss_binds bindings), rhs_fvs')] ++ + [FB (mkVarSet ids) rhs_fvs' + (FloatLet (Rec (fi_bind rhss_binds bindings)))] ++ -- The new binding itself extra_binds ++ -- Note [extra_fvs (1,2)] shared_binds -- Used in more than one place @@ -330,7 +341,7 @@ fiExpr to_drop (_,AnnLet (AnnRec bindings) body) rule_fvs -- Don't forget the rule variables! -- Push rhs_binds into the right hand side of the binding - fi_bind :: [FloatingBinds] -- one per "drop pt" conjured w/ fvs_of_rhss + fi_bind :: [FloatInBinds] -- one per "drop pt" conjured w/ fvs_of_rhss -> [(Id, CoreExprWithFVs)] -> [(Id, CoreExpr)] @@ -344,17 +355,32 @@ bindings are: (a)~inside the scrutinee, (b)~inside one of the alternatives/default [default FVs always {\em first}!]. \begin{code} +fiExpr to_drop (_, AnnCase scrut case_bndr _ [(DEFAULT,[],rhs)]) + | isUnLiftedType (idType case_bndr) + , exprOkForSideEffects (deAnnotate scrut) + = wrapFloats shared_binds $ + fiExpr (case_float : rhs_binds) rhs + where + case_float = FB (unitVarSet case_bndr) scrut_fvs + (FloatCase scrut' case_bndr DEFAULT []) + scrut' = fiExpr scrut_binds scrut + [shared_binds, scrut_binds, rhs_binds] + = sepBindsByDropPoint False [freeVarsOf scrut, rhs_fvs] to_drop + rhs_fvs = freeVarsOf rhs `delVarSet` case_bndr + scrut_fvs = freeVarsOf scrut + fiExpr to_drop (_, AnnCase scrut case_bndr ty alts) - = mkCoLets' drop_here1 $ - mkCoLets' drop_here2 $ + = wrapFloats drop_here1 $ + wrapFloats drop_here2 $ Case (fiExpr scrut_drops scrut) case_bndr ty (zipWith fi_alt alts_drops_s alts) where -- Float into the scrut and alts-considered-together just like App - [drop_here1, scrut_drops, alts_drops] = sepBindsByDropPoint False [scrut_fvs, all_alts_fvs] to_drop + [drop_here1, scrut_drops, alts_drops] + = sepBindsByDropPoint False [scrut_fvs, all_alts_fvs] to_drop -- Float into the alts with the is_case flag set - (drop_here2 : alts_drops_s) = sepBindsByDropPoint True alts_fvs alts_drops + (drop_here2 : alts_drops_s) = sepBindsByDropPoint True alts_fvs alts_drops scrut_fvs = freeVarsOf scrut alts_fvs = map alt_fvs alts @@ -376,7 +402,9 @@ noFloatIntoRhs (AnnLam b _) = not (is_one_shot b) -- boxing constructor into it, else we box it every time which is very bad -- news indeed. -noFloatIntoRhs rhs = exprIsHNF (deAnnotate' rhs) -- We'd just float right back out again... +noFloatIntoRhs rhs = exprIsExpandable (deAnnotate' rhs) + -- We'd just float right back out again... + -- Should match the test in SimplEnv.doFloatFromRhs is_one_shot :: Var -> Bool is_one_shot b = isId b && isOneShotBndr b @@ -407,9 +435,9 @@ We have to maintain the order on these drop-point-related lists. \begin{code} sepBindsByDropPoint :: Bool -- True <=> is case expression - -> [FreeVarsSet] -- One set of FVs per drop point - -> FloatingBinds -- Candidate floaters - -> [FloatingBinds] -- FIRST one is bindings which must not be floated + -> [FreeVarSet] -- One set of FVs per drop point + -> FloatInBinds -- Candidate floaters + -> [FloatInBinds] -- FIRST one is bindings which must not be floated -- inside any drop point; the rest correspond -- one-to-one with the input list of FV sets @@ -419,7 +447,7 @@ sepBindsByDropPoint -- a binding (let x = E in B) might have a specialised version of -- x (say x') stored inside x, but x' isn't free in E or B. -type DropBox = (FreeVarsSet, FloatingBinds) +type DropBox = (FreeVarSet, FloatInBinds) sepBindsByDropPoint _is_case drop_pts [] = [] : [[] | _ <- drop_pts] -- cut to the chase scene; it happens @@ -427,19 +455,19 @@ sepBindsByDropPoint _is_case drop_pts [] sepBindsByDropPoint is_case drop_pts floaters = go floaters (map (\fvs -> (fvs, [])) (emptyVarSet : drop_pts)) where - go :: FloatingBinds -> [DropBox] -> [FloatingBinds] + go :: FloatInBinds -> [DropBox] -> [FloatInBinds] -- The *first* one in the argument list is the drop_here set - -- The FloatingBinds in the lists are in the reverse of - -- the normal FloatingBinds order; that is, they are the right way round! + -- The FloatInBinds in the lists are in the reverse of + -- the normal FloatInBinds order; that is, they are the right way round! go [] drop_boxes = map (reverse . snd) drop_boxes - go (bind_w_fvs@(bind, bind_fvs) : binds) drop_boxes@(here_box : fork_boxes) + go (bind_w_fvs@(FB bndrs bind_fvs bind) : binds) drop_boxes@(here_box : fork_boxes) = go binds new_boxes where -- "here" means the group of bindings dropped at the top of the fork - (used_here : used_in_flags) = [ any (`elemVarSet` fvs) (bindersOf bind) + (used_here : used_in_flags) = [ fvs `intersectsVarSet` bndrs | (fvs, _) <- drop_boxes] drop_here = used_here || not can_push @@ -460,7 +488,7 @@ sepBindsByDropPoint is_case drop_pts floaters || (is_case && -- We are looking at case alternatives n_used_alts > 1 && -- It's used in more than one n_used_alts < n_alts && -- ...but not all - bindIsDupable bind) -- and we can duplicate the binding + floatIsDupable bind) -- and we can duplicate the binding new_boxes | drop_here = (insert here_box : fork_boxes) | otherwise = (here_box : new_fork_boxes) @@ -476,14 +504,19 @@ sepBindsByDropPoint is_case drop_pts floaters go _ _ = panic "sepBindsByDropPoint/go" -floatedBindsFVs :: FloatingBinds -> FreeVarsSet -floatedBindsFVs binds = unionVarSets (map snd binds) +floatedBindsFVs :: FloatInBinds -> FreeVarSet +floatedBindsFVs binds = foldr (unionVarSet . fbFVs) emptyVarSet binds + +fbFVs :: FloatInBind -> VarSet +fbFVs (FB _ fvs _) = fvs -mkCoLets' :: FloatingBinds -> CoreExpr -> CoreExpr -mkCoLets' to_drop e = foldl (flip (Let . fst)) e to_drop - -- Remember to_drop is in *reverse* dependency order +wrapFloats :: FloatInBinds -> CoreExpr -> CoreExpr +-- Remember FloatInBinds is in *reverse* dependency order +wrapFloats [] e = e +wrapFloats (FB _ _ fl : bs) e = wrapFloats bs (wrapFloat fl e) -bindIsDupable :: Bind CoreBndr -> Bool -bindIsDupable (Rec prs) = all (exprIsDupable . snd) prs -bindIsDupable (NonRec _ r) = exprIsDupable r +floatIsDupable :: FloatBind -> Bool +floatIsDupable (FloatCase scrut _ _ _) = exprIsDupable scrut +floatIsDupable (FloatLet (Rec prs)) = all (exprIsDupable . snd) prs +floatIsDupable (FloatLet (NonRec _ r)) = exprIsDupable r \end{code} diff --git a/compiler/simplCore/FloatOut.lhs b/compiler/simplCore/FloatOut.lhs index 00d6554790..18fc9b4af4 100644 --- a/compiler/simplCore/FloatOut.lhs +++ b/compiler/simplCore/FloatOut.lhs @@ -17,12 +17,12 @@ module FloatOut ( floatOutwards ) where import CoreSyn import CoreUtils +import MkCore import CoreArity ( etaExpand ) import CoreMonad ( FloatOutSwitches(..) ) import DynFlags ( DynFlags, DynFlag(..) ) import ErrUtils ( dumpIfSet_dyn ) -import DataCon ( DataCon ) import Id ( Id, idArity, isBottomingId ) import Var ( Var ) import SetLevels @@ -326,7 +326,7 @@ floatExpr (Let bind body) floatExpr (Case scrut (TB case_bndr case_spec) ty alts) = case case_spec of FloatMe dest_lvl -- Case expression moves - | [(DataAlt con, bndrs, rhs)] <- alts + | [(con@(DataAlt {}), bndrs, rhs)] <- alts -> case floatExpr scrut of { (fse, fde, scrut') -> case floatExpr rhs of { (fsb, fdb, rhs') -> let @@ -444,13 +444,6 @@ partitionByMajorLevel. \begin{code} -data FloatBind - = FloatLet FloatLet - - | FloatCase CoreExpr Id DataCon [Var] - -- case e of y { C ys -> ... } - -- See Note [Floating cases] in SetLevels - type FloatLet = CoreBind -- INVARIANT: a FloatLet is always lifted type MajorEnv = M.IntMap MinorEnv -- Keyed by major level type MinorEnv = M.IntMap (Bag FloatBind) -- Keyed by minor level @@ -491,7 +484,7 @@ flattenMinor = M.fold unionBags emptyBag emptyFloats :: FloatBinds emptyFloats = FB emptyBag M.empty -unitCaseFloat :: Level -> CoreExpr -> Id -> DataCon -> [Var] -> FloatBinds +unitCaseFloat :: Level -> CoreExpr -> Id -> AltCon -> [Var] -> FloatBinds unitCaseFloat (Level major minor) e b con bs = FB emptyBag (M.singleton major (M.singleton minor (unitBag (FloatCase e b con bs)))) @@ -514,12 +507,7 @@ plusMinor = M.unionWith unionBags install :: Bag FloatBind -> CoreExpr -> CoreExpr install defn_groups expr - = foldrBag install_group expr defn_groups - where - install_group (FloatLet defns) body - = Let defns body - install_group (FloatCase e b con bs) body - = Case e b (exprType body) [(DataAlt con, bs, body)] + = foldrBag wrapFloat expr defn_groups partitionByLevel :: Level -- Partitioning level diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs index a80dea4603..beb64cb061 100644 --- a/compiler/simplCore/SetLevels.lhs +++ b/compiler/simplCore/SetLevels.lhs @@ -423,7 +423,7 @@ Things to note * We only do this with a single-alternative case Note [Check the output scrutinee for okForSpec] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this: case x of y { A -> ....(case y of alts).... @@ -432,7 +432,7 @@ Because of the binder-swap, the inner case will get substituted to (case x of ..). So when testing whether the scrutinee is okForSpecuation we must be careful to test the *result* scrutinee ('x' in this case), not the *input* one 'y'. The latter *is* ok for -speculation here, but the former is not -- and ideed we can't float +speculation here, but the former is not -- and indeed we can't float the inner case out, at least not unless x is also evaluated at its binding site. diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 62f96e7c6e..8661d71e04 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -397,6 +397,7 @@ classifyFF (NonRec bndr rhs) | otherwise = FltCareful doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> OutExpr -> SimplEnv -> Bool +-- If you change this function look also at FloatIn.noFloatFromRhs doFloatFromRhs lvl rec str rhs (SimplEnv {seFloats = Floats fs ff}) = not (isNilOL fs) && want_to_float && can_float where diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 647da72d16..e025e6cb34 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -15,7 +15,7 @@ module SimplMonad ( -- The monad SimplM, initSmpl, - getDOptsSmpl, getSimplRules, getFamEnvs, + getSimplRules, getFamEnvs, -- Unique supply MonadUnique(..), newId, @@ -31,7 +31,7 @@ import Type ( Type ) import FamInstEnv ( FamInstEnv ) import Rules ( RuleBase ) import UniqSupply -import DynFlags ( DynFlags( simplTickFactor ) ) +import DynFlags import CoreMonad import Outputable import FastString @@ -148,8 +148,8 @@ instance MonadUnique SimplM where = SM (\_st_env us sc -> case splitUniqSupply us of (us1, us2) -> (uniqsFromSupply us1, us2, sc)) -getDOptsSmpl :: SimplM DynFlags -getDOptsSmpl = SM (\st_env us sc -> (st_flags st_env, us, sc)) +instance HasDynFlags SimplM where + getDynFlags = SM (\st_env us sc -> (st_flags st_env, us, sc)) getSimplRules :: SimplM RuleBase getSimplRules = SM (\st_env us sc -> (st_rules st_env, us, sc)) diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 86dc88ddd1..ad6fe5488b 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -1054,7 +1054,7 @@ mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr mkLam _b [] body = return body mkLam _env bndrs body - = do { dflags <- getDOptsSmpl + = do { dflags <- getDynFlags ; mkLam' dflags bndrs body } where mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr @@ -1125,7 +1125,7 @@ because the latter is not well-kinded. tryEtaExpand :: SimplEnv -> OutId -> OutExpr -> SimplM (Arity, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpand env bndr rhs - = do { dflags <- getDOptsSmpl + = do { dflags <- getDynFlags ; (new_arity, new_rhs) <- try_expand dflags ; WARN( new_arity < old_arity || new_arity < _dmd_arity, diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 2d84249e97..900d70c7de 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -221,7 +221,7 @@ simplTopBinds env0 binds0 -- It's rather as if the top-level binders were imported. -- See note [Glomming] in OccurAnal. ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0) - ; dflags <- getDOptsSmpl + ; dflags <- getDynFlags ; let dump_flag = dopt Opt_D_verbose_core2core dflags ; env2 <- simpl_binds dump_flag env1 binds0 ; freeTick SimplifierDone @@ -976,11 +976,6 @@ simplType env ty --------------------------------- simplCoercionF :: SimplEnv -> InCoercion -> SimplCont -> SimplM (SimplEnv, OutExpr) --- We are simplifying a term of form (Coercion co) --- Simplify the InCoercion, and then try to combine with the --- context, to implememt the rule --- (Coercion co) |> g --- = Coercion (syn (nth 0 g) ; co ; nth 1 g) simplCoercionF env co cont = do { co' <- simplCoercion env co ; rebuild env (Coercion co') cont } @@ -1164,7 +1159,7 @@ rebuild env expr cont = case cont of Stop {} -> return (env, expr) CoerceIt co cont -> rebuild env (mkCast expr co) cont - -- NB: mkCast implements the (Coercion co |> g) optimisation + -- NB: mkCast implements the (Coercion co |> g) optimisation Select _ bndr alts se cont -> rebuildCase (se `setFloats` env) expr bndr alts cont StrictArg info _ cont -> rebuildCall env (info `addArgTo` expr) cont StrictBind b bs body se cont -> do { env' <- simplNonRecX (se `setFloats` env) b expr @@ -1388,7 +1383,7 @@ simplIdF env var cont completeCall :: SimplEnv -> Id -> SimplCont -> SimplM (SimplEnv, OutExpr) completeCall env var cont = do { ------------- Try inlining ---------------- - dflags <- getDOptsSmpl + dflags <- getDynFlags ; let (lone_variable, arg_infos, call_cont) = contArgs cont -- The args are OutExprs, obtained by *lazily* substituting -- in the args found in cont. These args are only examined @@ -1564,7 +1559,7 @@ tryRules env rules fn args call_cont Just (rule, rule_rhs) -> do { checkedTick (RuleFired (ru_name rule)) - ; dflags <- getDOptsSmpl + ; dflags <- getDynFlags ; trace_dump dflags rule rule_rhs $ return (Just (ruleArity rule, rule_rhs)) }}} where @@ -1766,7 +1761,7 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont | all isDeadBinder bndrs -- bndrs are [InId] , if isUnLiftedType (idType case_bndr) - then ok_for_spec -- Satisfy the let-binding invariant + then elim_unlifted -- Satisfy the let-binding invariant else elim_lifted = do { -- pprTrace "case elim" (vcat [ppr case_bndr, ppr (exprIsHNF scrut), -- ppr strict_case_bndr, ppr (scrut_is_var scrut), @@ -1786,6 +1781,14 @@ rebuildCase env scrut case_bndr [(_, bndrs, rhs)] cont || (is_plain_seq && ok_for_spec) -- Note: not the same as exprIsHNF + elim_unlifted + | is_plain_seq = exprOkForSideEffects scrut + -- The entire case is dead, so we can drop it, + -- _unless_ the scrutinee has side effects + | otherwise = exprOkForSpeculation scrut + -- The case-binder is alive, but we may be able + -- turn the case into a let, if the expression is ok-for-spec + ok_for_spec = exprOkForSpeculation scrut is_plain_seq = isDeadBinder case_bndr -- Evaluation *only* for effect strict_case_bndr = isStrictDmd (idDemandInfo case_bndr) @@ -1832,7 +1835,7 @@ reallyRebuildCase env scrut case_bndr alts cont -- Check for empty alternatives ; if null alts' then missingAlt env case_bndr alts cont else do - { dflags <- getDOptsSmpl + { dflags <- getDynFlags ; case_expr <- mkCase dflags scrut' case_bndr' alts' -- Notice that rebuild gets the in-scope set from env', not alt_env diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 614798873e..0bfd025410 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -265,17 +265,26 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) idDemandInfo case_bndr' (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut + res_ty = alt_ty1 `bothType` scrut_ty in - (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' ty [alt']) +-- pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut +-- , text "scrut_ty" <+> ppr scrut_ty +-- , text "alt_ty" <+> ppr alt_ty1 +-- , text "res_ty" <+> ppr res_ty ]) $ + (res_ty, Case scrut' case_bndr' ty [alt']) dmdAnal env dmd (Case scrut case_bndr ty alts) = let (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd) alts (scrut_ty, scrut') = dmdAnal env evalDmd scrut (alt_ty, case_bndr') = annotateBndr (foldr1 lubType alt_tys) case_bndr + res_ty = alt_ty `bothType` scrut_ty in --- pprTrace "dmdAnal:Case" (ppr alts $$ ppr alt_tys) - (alt_ty `bothType` scrut_ty, Case scrut' case_bndr' ty alts') +-- pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut +-- , text "scrut_ty" <+> ppr scrut_ty +-- , text "alt_ty" <+> ppr alt_ty +-- , text "res_ty" <+> ppr res_ty ]) $ + (res_ty, Case scrut' case_bndr' ty alts') dmdAnal env dmd (Let (NonRec id rhs) body) = let @@ -337,7 +346,7 @@ dmdAnalAlt env dmd (con,bndrs,rhs) -- other -> return () -- So the 'y' isn't necessarily going to be evaluated -- - -- A more complete example where this shows up is: + -- A more complete example (Trac #148, #1592) where this shows up is: -- do { let len = <expensive> ; -- ; when (...) (exitWith ExitSuccess) -- ; print len } diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 6269051e5f..98305e48a2 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -21,6 +21,7 @@ import TypeRep import TcMType import TcRnMonad import TyCon +import DynFlags import Name import Module import SrcLoc @@ -92,7 +93,7 @@ listToSet l = Map.fromList (zip l (repeat ())) checkFamInstConsistency :: [Module] -> [Module] -> TcM () checkFamInstConsistency famInstMods directlyImpMods - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; (eps, hpt) <- getEpsAndHpt ; let { -- Fetch the iface of a given module. Must succeed as diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs index b589c265db..a194d748ed 100644 --- a/compiler/typecheck/Inst.lhs +++ b/compiler/typecheck/Inst.lhs @@ -377,7 +377,7 @@ syntaxNameCtxt name orig ty tidy_env = do \begin{code} getOverlapFlag :: TcM OverlapFlag getOverlapFlag - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; let overlap_ok = xopt Opt_OverlappingInstances dflags incoherent_ok = xopt Opt_IncoherentInstances dflags safeOverlap = safeLanguageOn dflags diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 7d20aaa946..e14bd49458 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -332,7 +332,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list -- (as determined by sig_fn), returning a TcSigInfo for each ; tc_sig_fn <- tcInstSigs sig_fn binder_names - ; dflags <- getDOpts + ; dflags <- getDynFlags ; type_env <- getLclTypeEnv ; let plan = decideGeneralisationPlan dflags type_env binder_names bind_list tc_sig_fn @@ -585,7 +585,8 @@ tcSpec poly_id prag@(SpecSig _ hs_ty inl) = addErrCtxt (spec_ctxt prag) $ do { spec_ty <- tcHsSigType sig_ctxt hs_ty ; warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) - (ptext (sLit "SPECIALISE pragma for non-overloaded function") <+> quotes (ppr poly_id)) + (ptext (sLit "SPECIALISE pragma for non-overloaded function") + <+> quotes (ppr poly_id)) -- Note [SPECIALISE pragmas] ; wrap <- tcSubType origin sig_ctxt (idType poly_id) spec_ty ; return (SpecPrag poly_id wrap inl) } @@ -603,7 +604,7 @@ tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag] -- SPECIALISE pragamas for imported things tcImpPrags prags = do { this_mod <- getModule - ; dflags <- getDOpts + ; dflags <- getDynFlags ; if (not_specialising dflags) then return [] else diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs index 77f1c42982..ac1895fe35 100644 --- a/compiler/typecheck/TcClassDcl.lhs +++ b/compiler/typecheck/TcClassDcl.lhs @@ -363,7 +363,7 @@ mkGenericDefMethBind clas inst_tys sel_id dm_name = -- A generic default method -- If the method is defined generically, we only have to call the -- dm_name. - do { dflags <- getDOpts + do { dflags <- getDynFlags ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body" (vcat [ppr clas <+> ppr inst_tys, nest 2 (ppr sel_id <+> equals <+> ppr rhs)])) diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index dda82fff99..4db96c6e3c 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -331,7 +331,7 @@ tcDeriving tycl_decls inst_decls deriv_decls ; (inst_info, rn_binds, rn_dus) <- renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) binds - ; dflags <- getDOpts + ; dflags <- getDynFlags ; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" (ddump_deriving inst_info rn_binds newTyCons famInsts)) @@ -617,7 +617,7 @@ mkEqnHelp orig tvs cls cls_tys tc_app mtheta mk_alg_eqn tycon tc_args | className cls `elem` typeableClassNames - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; case checkTypeableConditions (dflags, tycon) of Just err -> bale_out err Nothing -> mk_typeable_eqn orig tvs cls tycon tc_args mtheta } @@ -641,7 +641,7 @@ mkEqnHelp orig tvs cls cls_tys tc_app mtheta ; unless (isNothing mtheta || not hidden_data_cons) (bale_out (derivingHiddenErr tycon)) - ; dflags <- getDOpts + ; dflags <- getDynFlags ; if isDataTyCon rep_tc then mkDataTypeEqn orig dflags tvs cls cls_tys tycon tc_args rep_tc rep_tc_args mtheta diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 915978ba3a..ae320ce692 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -558,7 +558,7 @@ tcGetDefaultTys :: Bool -- True <=> interactive context (Bool, -- True <=> Use overloaded strings Bool)) -- True <=> Use extended defaulting rules tcGetDefaultTys interactive - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; let ovl_strings = xopt Opt_OverloadedStrings dflags extended_defaults = interactive || xopt Opt_ExtendedDefaultRules dflags diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index a6aef315ab..5d5413d145 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -900,7 +900,7 @@ mkAmbigMsg ctxt cts | isEmptyVarSet ambig_tv_set = return (ctxt, False, empty) | otherwise - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; (ctxt', gbl_docs) <- findGlobals ctxt ambig_tv_set ; return (ctxt', True, mk_msg dflags gbl_docs) } where diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index 93c5bf56ea..8b724a4cac 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -1,515 +1,515 @@ -%
-% (c) The University of Glasgow 2006
-%
-
-\begin{code}
-module TcEvidence (
-
- -- HsWrapper
- HsWrapper(..),
- (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet,
- idHsWrapper, isIdHsWrapper, pprHsWrapper,
-
- -- Evidence bindin
- TcEvBinds(..), EvBindsVar(..),
- EvBindMap(..), emptyEvBindMap, extendEvBinds, lookupEvBind, evBindMapBinds,
-
- EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds,
-
- EvTerm(..), mkEvCast, evVarsOfTerm, mkEvKindCast,
-
- -- TcCoercion
- TcCoercion(..),
- mkTcReflCo, mkTcTyConAppCo, mkTcAppCo, mkTcAppCos, mkTcFunCo,
- mkTcAxInstCo, mkTcForAllCo, mkTcForAllCos,
- mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcInstCos,
- tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo,
- isTcReflCo, isTcReflCo_maybe, getTcCoVar_maybe,
- liftTcCoSubstWith
-
- ) where
-#include "HsVersions.h"
-
-import Var
-
-import PprCore () -- Instance OutputableBndr TyVar
-import TypeRep -- Knows type representation
-import TcType
-import Type( tyConAppArgN, getEqPredTys_maybe, tyConAppTyCon_maybe )
-import TysPrim( funTyCon )
-import TyCon
-import PrelNames
-import VarEnv
-import VarSet
-import Name
-
-import Util
-import Bag
-import Pair
-import Control.Applicative
-import Data.Traversable (traverse, sequenceA)
-import qualified Data.Data as Data
-import Outputable
-import FastString
-import Data.IORef( IORef )
-\end{code}
-
-
-Note [TcCoercions]
-~~~~~~~~~~~~~~~~~~
-| LCoercions are a hack used by the typechecker. Normally,
-Coercions have free variables of type (a ~# b): we call these
-CoVars. However, the type checker passes around equality evidence
-(boxed up) at type (a ~ b).
-
-An LCoercion is simply a Coercion whose free variables have the
-boxed type (a ~ b). After we are done with typechecking the
-desugarer finds the free variables, unboxes them, and creates a
-resulting real Coercion with kosher free variables.
-
-We can use most of the Coercion "smart constructors" to build LCoercions. However,
-mkCoVarCo will not work! The equivalent is mkTcCoVarCo.
-
-The data type is similar to Coercion.Coercion, with the following
-differences
- * Most important, TcLetCo adds let-bindings for coercions.
- This is what lets us unify two for-all types and generate
- equality constraints underneath
-
- * The kind of a TcCoercion is t1 ~ t2
- of a Coercion is t1 ~# t2
-
- * TcAxiomInstCo takes Types, not Coecions as arguments;
- the generality is required only in the Simplifier
-
- * UnsafeCo aren't required
-
- * Reprsentation invariants are weaker:
- - we are allowed to have type synonyms in TcTyConAppCo
- - the first arg of a TcAppCo can be a TcTyConAppCo
- Reason: they'll get established when we desugar to Coercion
-
-\begin{code}
-data TcCoercion
- = TcRefl TcType
- | TcTyConAppCo TyCon [TcCoercion]
- | TcAppCo TcCoercion TcCoercion
- | TcForAllCo TyVar TcCoercion
- | TcInstCo TcCoercion TcType
- | TcCoVarCo EqVar
- | TcAxiomInstCo CoAxiom [TcType]
- | TcSymCo TcCoercion
- | TcTransCo TcCoercion TcCoercion
- | TcNthCo Int TcCoercion
- | TcLetCo TcEvBinds TcCoercion
- deriving (Data.Data, Data.Typeable)
-
-isEqVar :: Var -> Bool
--- Is lifted coercion variable (only!)
-isEqVar v = case tyConAppTyCon_maybe (varType v) of
- Just tc -> tc `hasKey` eqTyConKey
- Nothing -> False
-
-isTcReflCo_maybe :: TcCoercion -> Maybe TcType
-isTcReflCo_maybe (TcRefl ty) = Just ty
-isTcReflCo_maybe _ = Nothing
-
-isTcReflCo :: TcCoercion -> Bool
-isTcReflCo (TcRefl {}) = True
-isTcReflCo _ = False
-
-getTcCoVar_maybe :: TcCoercion -> Maybe CoVar
-getTcCoVar_maybe (TcCoVarCo v) = Just v
-getTcCoVar_maybe _ = Nothing
-
-mkTcReflCo :: TcType -> TcCoercion
-mkTcReflCo = TcRefl
-
-mkTcFunCo :: TcCoercion -> TcCoercion -> TcCoercion
-mkTcFunCo co1 co2 = mkTcTyConAppCo funTyCon [co1, co2]
-
-mkTcTyConAppCo :: TyCon -> [TcCoercion] -> TcCoercion
-mkTcTyConAppCo tc cos -- No need to expand type synonyms
- -- See Note [TcCoercions]
- | Just tys <- traverse isTcReflCo_maybe cos
- = TcRefl (mkTyConApp tc tys) -- See Note [Refl invariant]
-
- | otherwise = TcTyConAppCo tc cos
-
-mkTcAxInstCo :: CoAxiom -> [TcType] -> TcCoercion
-mkTcAxInstCo ax tys
- | arity == n_tys = TcAxiomInstCo ax tys
- | otherwise = ASSERT( arity < n_tys )
- foldl TcAppCo (TcAxiomInstCo ax (take arity tys))
- (map TcRefl (drop arity tys))
- where
- n_tys = length tys
- arity = coAxiomArity ax
-
-mkTcAppCo :: TcCoercion -> TcCoercion -> TcCoercion
--- No need to deal with TyConApp on the left; see Note [TcCoercions]
-mkTcAppCo (TcRefl ty1) (TcRefl ty2) = TcRefl (mkAppTy ty1 ty2)
-mkTcAppCo co1 co2 = TcAppCo co1 co2
-
-mkTcSymCo :: TcCoercion -> TcCoercion
-mkTcSymCo co@(TcRefl {}) = co
-mkTcSymCo (TcSymCo co) = co
-mkTcSymCo co = TcSymCo co
-
-mkTcTransCo :: TcCoercion -> TcCoercion -> TcCoercion
-mkTcTransCo (TcRefl _) co = co
-mkTcTransCo co (TcRefl _) = co
-mkTcTransCo co1 co2 = TcTransCo co1 co2
-
-mkTcNthCo :: Int -> TcCoercion -> TcCoercion
-mkTcNthCo n (TcRefl ty) = TcRefl (tyConAppArgN n ty)
-mkTcNthCo n co = TcNthCo n co
-
-mkTcAppCos :: TcCoercion -> [TcCoercion] -> TcCoercion
-mkTcAppCos co1 tys = foldl mkTcAppCo co1 tys
-
-mkTcForAllCo :: Var -> TcCoercion -> TcCoercion
--- note that a TyVar should be used here, not a CoVar (nor a TcTyVar)
-mkTcForAllCo tv (TcRefl ty) = ASSERT( isTyVar tv ) TcRefl (mkForAllTy tv ty)
-mkTcForAllCo tv co = ASSERT( isTyVar tv ) TcForAllCo tv co
-
-mkTcForAllCos :: [Var] -> TcCoercion -> TcCoercion
-mkTcForAllCos tvs (TcRefl ty) = ASSERT( all isTyVar tvs ) TcRefl (mkForAllTys tvs ty)
-mkTcForAllCos tvs co = ASSERT( all isTyVar tvs ) foldr TcForAllCo co tvs
-
-mkTcInstCos :: TcCoercion -> [TcType] -> TcCoercion
-mkTcInstCos (TcRefl ty) tys = TcRefl (applyTys ty tys)
-mkTcInstCos co tys = foldl TcInstCo co tys
-
-mkTcCoVarCo :: EqVar -> TcCoercion
--- ipv :: s ~ t (the boxed equality type)
-mkTcCoVarCo ipv
- | ty1 `eqType` ty2 = TcRefl ty1
- | otherwise = TcCoVarCo ipv
- where
- (ty1, ty2) = case getEqPredTys_maybe (varType ipv) of
- Nothing -> pprPanic "mkCoVarLCo" (ppr ipv)
- Just tys -> tys
-\end{code}
-
-\begin{code}
-tcCoercionKind :: TcCoercion -> Pair Type
-tcCoercionKind co = go co
- where
- go (TcRefl ty) = Pair ty ty
- go (TcLetCo _ co) = go co
- go (TcTyConAppCo tc cos) = mkTyConApp tc <$> (sequenceA $ map go cos)
- go (TcAppCo co1 co2) = mkAppTy <$> go co1 <*> go co2
- go (TcForAllCo tv co) = mkForAllTy tv <$> go co
- go (TcInstCo co ty) = go_inst co [ty]
- go (TcCoVarCo cv) = eqVarKind cv
- go (TcAxiomInstCo ax tys) = Pair (substTyWith (co_ax_tvs ax) tys (co_ax_lhs ax))
- (substTyWith (co_ax_tvs ax) tys (co_ax_rhs ax))
- go (TcSymCo co) = swap $ go co
- go (TcTransCo co1 co2) = Pair (pFst $ go co1) (pSnd $ go co2)
- go (TcNthCo d co) = tyConAppArgN d <$> go co
-
- -- c.f. Coercion.coercionKind
- go_inst (TcInstCo co ty) tys = go_inst co (ty:tys)
- go_inst co tys = (`applyTys` tys) <$> go co
-
-eqVarKind :: EqVar -> Pair Type
-eqVarKind cv
- | Just (tc, [_kind,ty1,ty2]) <- tcSplitTyConApp_maybe (varType cv)
- = ASSERT (tc `hasKey` eqTyConKey)
- Pair ty1 ty2
- | otherwise = panic "eqVarKind, non coercion variable"
-
-coVarsOfTcCo :: TcCoercion -> VarSet
--- Only works on *zonked* coercions, because of TcLetCo
-coVarsOfTcCo tc_co
- = go tc_co
- where
- go (TcRefl _) = emptyVarSet
- go (TcTyConAppCo _ cos) = foldr (unionVarSet . go) emptyVarSet cos
- go (TcAppCo co1 co2) = go co1 `unionVarSet` go co2
- go (TcForAllCo _ co) = go co
- go (TcInstCo co _) = go co
- go (TcCoVarCo v) = unitVarSet v
- go (TcAxiomInstCo {}) = emptyVarSet
- go (TcSymCo co) = go co
- go (TcTransCo co1 co2) = go co1 `unionVarSet` go co2
- go (TcNthCo _ co) = go co
- go (TcLetCo (EvBinds bs) co) = foldrBag (unionVarSet . go_bind) (go co) bs
- `minusVarSet` get_bndrs bs
- go (TcLetCo {}) = pprPanic "coVarsOfTcCo called on non-zonked TcCoercion" (ppr tc_co)
-
- -- We expect only coercion bindings
- go_bind :: EvBind -> VarSet
- go_bind (EvBind _ (EvCoercion co)) = go co
- go_bind (EvBind _ (EvId v)) = unitVarSet v
- go_bind other = pprPanic "coVarsOfTcCo:Bind" (ppr other)
-
- get_bndrs :: Bag EvBind -> VarSet
- get_bndrs = foldrBag (\ (EvBind b _) bs -> extendVarSet bs b) emptyVarSet
-
-liftTcCoSubstWith :: [TyVar] -> [TcCoercion] -> TcType -> TcCoercion
--- This version can ignore capture; the free varialbes of the
--- TcCoerion are all fresh. Result is mush simpler code
-liftTcCoSubstWith tvs cos ty
- = ASSERT( equalLength tvs cos )
- go ty
- where
- env = zipVarEnv tvs cos
-
- go ty@(TyVarTy tv) = case lookupVarEnv env tv of
- Just co -> co
- Nothing -> mkTcReflCo ty
- go (AppTy t1 t2) = mkTcAppCo (go t1) (go t2)
- go (TyConApp tc tys) = mkTcTyConAppCo tc (map go tys)
+% +% (c) The University of Glasgow 2006 +% + +\begin{code} +module TcEvidence ( + + -- HsWrapper + HsWrapper(..), + (<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, + idHsWrapper, isIdHsWrapper, pprHsWrapper, + + -- Evidence bindin + TcEvBinds(..), EvBindsVar(..), + EvBindMap(..), emptyEvBindMap, extendEvBinds, lookupEvBind, evBindMapBinds, + + EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, + + EvTerm(..), mkEvCast, evVarsOfTerm, mkEvKindCast, + + -- TcCoercion + TcCoercion(..), + mkTcReflCo, mkTcTyConAppCo, mkTcAppCo, mkTcAppCos, mkTcFunCo, + mkTcAxInstCo, mkTcForAllCo, mkTcForAllCos, + mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcInstCos, + tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo, + isTcReflCo, isTcReflCo_maybe, getTcCoVar_maybe, + liftTcCoSubstWith + + ) where +#include "HsVersions.h" + +import Var + +import PprCore () -- Instance OutputableBndr TyVar +import TypeRep -- Knows type representation +import TcType +import Type( tyConAppArgN, getEqPredTys_maybe, tyConAppTyCon_maybe ) +import TysPrim( funTyCon ) +import TyCon +import PrelNames +import VarEnv +import VarSet +import Name + +import Util +import Bag +import Pair +import Control.Applicative +import Data.Traversable (traverse, sequenceA) +import qualified Data.Data as Data +import Outputable +import FastString +import Data.IORef( IORef ) +\end{code} + + +Note [TcCoercions] +~~~~~~~~~~~~~~~~~~ +| LCoercions are a hack used by the typechecker. Normally, +Coercions have free variables of type (a ~# b): we call these +CoVars. However, the type checker passes around equality evidence +(boxed up) at type (a ~ b). + +An LCoercion is simply a Coercion whose free variables have the +boxed type (a ~ b). After we are done with typechecking the +desugarer finds the free variables, unboxes them, and creates a +resulting real Coercion with kosher free variables. + +We can use most of the Coercion "smart constructors" to build LCoercions. However, +mkCoVarCo will not work! The equivalent is mkTcCoVarCo. + +The data type is similar to Coercion.Coercion, with the following +differences + * Most important, TcLetCo adds let-bindings for coercions. + This is what lets us unify two for-all types and generate + equality constraints underneath + + * The kind of a TcCoercion is t1 ~ t2 + of a Coercion is t1 ~# t2 + + * TcAxiomInstCo takes Types, not Coecions as arguments; + the generality is required only in the Simplifier + + * UnsafeCo aren't required + + * Reprsentation invariants are weaker: + - we are allowed to have type synonyms in TcTyConAppCo + - the first arg of a TcAppCo can be a TcTyConAppCo + Reason: they'll get established when we desugar to Coercion + +\begin{code} +data TcCoercion + = TcRefl TcType + | TcTyConAppCo TyCon [TcCoercion] + | TcAppCo TcCoercion TcCoercion + | TcForAllCo TyVar TcCoercion + | TcInstCo TcCoercion TcType + | TcCoVarCo EqVar + | TcAxiomInstCo CoAxiom [TcType] + | TcSymCo TcCoercion + | TcTransCo TcCoercion TcCoercion + | TcNthCo Int TcCoercion + | TcLetCo TcEvBinds TcCoercion + deriving (Data.Data, Data.Typeable) + +isEqVar :: Var -> Bool +-- Is lifted coercion variable (only!) +isEqVar v = case tyConAppTyCon_maybe (varType v) of + Just tc -> tc `hasKey` eqTyConKey + Nothing -> False + +isTcReflCo_maybe :: TcCoercion -> Maybe TcType +isTcReflCo_maybe (TcRefl ty) = Just ty +isTcReflCo_maybe _ = Nothing + +isTcReflCo :: TcCoercion -> Bool +isTcReflCo (TcRefl {}) = True +isTcReflCo _ = False + +getTcCoVar_maybe :: TcCoercion -> Maybe CoVar +getTcCoVar_maybe (TcCoVarCo v) = Just v +getTcCoVar_maybe _ = Nothing + +mkTcReflCo :: TcType -> TcCoercion +mkTcReflCo = TcRefl + +mkTcFunCo :: TcCoercion -> TcCoercion -> TcCoercion +mkTcFunCo co1 co2 = mkTcTyConAppCo funTyCon [co1, co2] + +mkTcTyConAppCo :: TyCon -> [TcCoercion] -> TcCoercion +mkTcTyConAppCo tc cos -- No need to expand type synonyms + -- See Note [TcCoercions] + | Just tys <- traverse isTcReflCo_maybe cos + = TcRefl (mkTyConApp tc tys) -- See Note [Refl invariant] + + | otherwise = TcTyConAppCo tc cos + +mkTcAxInstCo :: CoAxiom -> [TcType] -> TcCoercion +mkTcAxInstCo ax tys + | arity == n_tys = TcAxiomInstCo ax tys + | otherwise = ASSERT( arity < n_tys ) + foldl TcAppCo (TcAxiomInstCo ax (take arity tys)) + (map TcRefl (drop arity tys)) + where + n_tys = length tys + arity = coAxiomArity ax + +mkTcAppCo :: TcCoercion -> TcCoercion -> TcCoercion +-- No need to deal with TyConApp on the left; see Note [TcCoercions] +mkTcAppCo (TcRefl ty1) (TcRefl ty2) = TcRefl (mkAppTy ty1 ty2) +mkTcAppCo co1 co2 = TcAppCo co1 co2 + +mkTcSymCo :: TcCoercion -> TcCoercion +mkTcSymCo co@(TcRefl {}) = co +mkTcSymCo (TcSymCo co) = co +mkTcSymCo co = TcSymCo co + +mkTcTransCo :: TcCoercion -> TcCoercion -> TcCoercion +mkTcTransCo (TcRefl _) co = co +mkTcTransCo co (TcRefl _) = co +mkTcTransCo co1 co2 = TcTransCo co1 co2 + +mkTcNthCo :: Int -> TcCoercion -> TcCoercion +mkTcNthCo n (TcRefl ty) = TcRefl (tyConAppArgN n ty) +mkTcNthCo n co = TcNthCo n co + +mkTcAppCos :: TcCoercion -> [TcCoercion] -> TcCoercion +mkTcAppCos co1 tys = foldl mkTcAppCo co1 tys + +mkTcForAllCo :: Var -> TcCoercion -> TcCoercion +-- note that a TyVar should be used here, not a CoVar (nor a TcTyVar) +mkTcForAllCo tv (TcRefl ty) = ASSERT( isTyVar tv ) TcRefl (mkForAllTy tv ty) +mkTcForAllCo tv co = ASSERT( isTyVar tv ) TcForAllCo tv co + +mkTcForAllCos :: [Var] -> TcCoercion -> TcCoercion +mkTcForAllCos tvs (TcRefl ty) = ASSERT( all isTyVar tvs ) TcRefl (mkForAllTys tvs ty) +mkTcForAllCos tvs co = ASSERT( all isTyVar tvs ) foldr TcForAllCo co tvs + +mkTcInstCos :: TcCoercion -> [TcType] -> TcCoercion +mkTcInstCos (TcRefl ty) tys = TcRefl (applyTys ty tys) +mkTcInstCos co tys = foldl TcInstCo co tys + +mkTcCoVarCo :: EqVar -> TcCoercion +-- ipv :: s ~ t (the boxed equality type) +mkTcCoVarCo ipv + | ty1 `eqType` ty2 = TcRefl ty1 + | otherwise = TcCoVarCo ipv + where + (ty1, ty2) = case getEqPredTys_maybe (varType ipv) of + Nothing -> pprPanic "mkCoVarLCo" (ppr ipv) + Just tys -> tys +\end{code} + +\begin{code} +tcCoercionKind :: TcCoercion -> Pair Type +tcCoercionKind co = go co + where + go (TcRefl ty) = Pair ty ty + go (TcLetCo _ co) = go co + go (TcTyConAppCo tc cos) = mkTyConApp tc <$> (sequenceA $ map go cos) + go (TcAppCo co1 co2) = mkAppTy <$> go co1 <*> go co2 + go (TcForAllCo tv co) = mkForAllTy tv <$> go co + go (TcInstCo co ty) = go_inst co [ty] + go (TcCoVarCo cv) = eqVarKind cv + go (TcAxiomInstCo ax tys) = Pair (substTyWith (co_ax_tvs ax) tys (co_ax_lhs ax)) + (substTyWith (co_ax_tvs ax) tys (co_ax_rhs ax)) + go (TcSymCo co) = swap $ go co + go (TcTransCo co1 co2) = Pair (pFst $ go co1) (pSnd $ go co2) + go (TcNthCo d co) = tyConAppArgN d <$> go co + + -- c.f. Coercion.coercionKind + go_inst (TcInstCo co ty) tys = go_inst co (ty:tys) + go_inst co tys = (`applyTys` tys) <$> go co + +eqVarKind :: EqVar -> Pair Type +eqVarKind cv + | Just (tc, [_kind,ty1,ty2]) <- tcSplitTyConApp_maybe (varType cv) + = ASSERT (tc `hasKey` eqTyConKey) + Pair ty1 ty2 + | otherwise = panic "eqVarKind, non coercion variable" + +coVarsOfTcCo :: TcCoercion -> VarSet +-- Only works on *zonked* coercions, because of TcLetCo +coVarsOfTcCo tc_co + = go tc_co + where + go (TcRefl _) = emptyVarSet + go (TcTyConAppCo _ cos) = foldr (unionVarSet . go) emptyVarSet cos + go (TcAppCo co1 co2) = go co1 `unionVarSet` go co2 + go (TcForAllCo _ co) = go co + go (TcInstCo co _) = go co + go (TcCoVarCo v) = unitVarSet v + go (TcAxiomInstCo {}) = emptyVarSet + go (TcSymCo co) = go co + go (TcTransCo co1 co2) = go co1 `unionVarSet` go co2 + go (TcNthCo _ co) = go co + go (TcLetCo (EvBinds bs) co) = foldrBag (unionVarSet . go_bind) (go co) bs + `minusVarSet` get_bndrs bs + go (TcLetCo {}) = pprPanic "coVarsOfTcCo called on non-zonked TcCoercion" (ppr tc_co) + + -- We expect only coercion bindings + go_bind :: EvBind -> VarSet + go_bind (EvBind _ (EvCoercion co)) = go co + go_bind (EvBind _ (EvId v)) = unitVarSet v + go_bind other = pprPanic "coVarsOfTcCo:Bind" (ppr other) + + get_bndrs :: Bag EvBind -> VarSet + get_bndrs = foldrBag (\ (EvBind b _) bs -> extendVarSet bs b) emptyVarSet + +liftTcCoSubstWith :: [TyVar] -> [TcCoercion] -> TcType -> TcCoercion +-- This version can ignore capture; the free varialbes of the +-- TcCoerion are all fresh. Result is mush simpler code +liftTcCoSubstWith tvs cos ty + = ASSERT( equalLength tvs cos ) + go ty + where + env = zipVarEnv tvs cos + + go ty@(TyVarTy tv) = case lookupVarEnv env tv of + Just co -> co + Nothing -> mkTcReflCo ty + go (AppTy t1 t2) = mkTcAppCo (go t1) (go t2) + go (TyConApp tc tys) = mkTcTyConAppCo tc (map go tys) go ty@(LitTy {}) = mkTcReflCo ty
- go (ForAllTy tv ty) = mkTcForAllCo tv (go ty)
- go (FunTy t1 t2) = mkTcFunCo (go t1) (go t2)
-\end{code}
-
-Pretty printing
-
-\begin{code}
-instance Outputable TcCoercion where
- ppr = pprTcCo
-
-pprTcCo, pprParendTcCo :: TcCoercion -> SDoc
-pprTcCo co = ppr_co TopPrec co
-pprParendTcCo co = ppr_co TyConPrec co
-
-ppr_co :: Prec -> TcCoercion -> SDoc
-ppr_co _ (TcRefl ty) = angleBrackets (ppr ty)
-
-ppr_co p co@(TcTyConAppCo tc [_,_])
- | tc `hasKey` funTyConKey = ppr_fun_co p co
-
-ppr_co p (TcTyConAppCo tc cos) = pprTcApp p ppr_co tc cos
-ppr_co p (TcLetCo bs co) = maybeParen p TopPrec $
- sep [ptext (sLit "let") <+> braces (ppr bs), ppr co]
-ppr_co p (TcAppCo co1 co2) = maybeParen p TyConPrec $
- pprTcCo co1 <+> ppr_co TyConPrec co2
-ppr_co p co@(TcForAllCo {}) = ppr_forall_co p co
-ppr_co p (TcInstCo co ty) = maybeParen p TyConPrec $
- pprParendTcCo co <> ptext (sLit "@") <> pprType ty
-
-ppr_co _ (TcCoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv)
-ppr_co p (TcAxiomInstCo con cos) = pprTypeNameApp p ppr_type (getName con) cos
-
-ppr_co p (TcTransCo co1 co2) = maybeParen p FunPrec $
- ppr_co FunPrec co1
- <+> ptext (sLit ";")
- <+> ppr_co FunPrec co2
-ppr_co p (TcSymCo co) = pprPrefixApp p (ptext (sLit "Sym")) [pprParendTcCo co]
-ppr_co p (TcNthCo n co) = pprPrefixApp p (ptext (sLit "Nth:") <+> int n) [pprParendTcCo co]
-
-ppr_fun_co :: Prec -> TcCoercion -> SDoc
-ppr_fun_co p co = pprArrowChain p (split co)
- where
- split :: TcCoercion -> [SDoc]
- split (TcTyConAppCo f [arg,res])
- | f `hasKey` funTyConKey
- = ppr_co FunPrec arg : split res
- split co = [ppr_co TopPrec co]
-
-ppr_forall_co :: Prec -> TcCoercion -> SDoc
-ppr_forall_co p ty
- = maybeParen p FunPrec $
- sep [pprForAll tvs, ppr_co TopPrec rho]
- where
- (tvs, rho) = split1 [] ty
- split1 tvs (TcForAllCo tv ty) = split1 (tv:tvs) ty
- split1 tvs ty = (reverse tvs, ty)
-\end{code}
-
-%************************************************************************
-%* *
- HsWrapper
-%* *
-%************************************************************************
-
-\begin{code}
-data HsWrapper
- = WpHole -- The identity coercion
-
- | WpCompose HsWrapper HsWrapper
- -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]]
- --
- -- Hence (\a. []) `WpCompose` (\b. []) = (\a b. [])
- -- But ([] a) `WpCompose` ([] b) = ([] b a)
-
- | WpCast TcCoercion -- A cast: [] `cast` co
- -- Guaranteed not the identity coercion
-
- -- Evidence abstraction and application
- -- (both dictionaries and coercions)
- | WpEvLam EvVar -- \d. [] the 'd' is an evidence variable
- | WpEvApp EvTerm -- [] d the 'd' is evidence for a constraint
-
- -- Kind and Type abstraction and application
- | WpTyLam TyVar -- \a. [] the 'a' is a type/kind variable (not coercion var)
- | WpTyApp KindOrType -- [] t the 't' is a type (not coercion)
-
-
- | WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings,
- -- so that the identity coercion is always exactly WpHole
- deriving (Data.Data, Data.Typeable)
-
-
-(<.>) :: HsWrapper -> HsWrapper -> HsWrapper
-WpHole <.> c = c
-c <.> WpHole = c
-c1 <.> c2 = c1 `WpCompose` c2
-
-mkWpTyApps :: [Type] -> HsWrapper
-mkWpTyApps tys = mk_co_app_fn WpTyApp tys
-
-mkWpEvApps :: [EvTerm] -> HsWrapper
-mkWpEvApps args = mk_co_app_fn WpEvApp args
-
-mkWpEvVarApps :: [EvVar] -> HsWrapper
-mkWpEvVarApps vs = mkWpEvApps (map EvId vs)
-
-mkWpTyLams :: [TyVar] -> HsWrapper
-mkWpTyLams ids = mk_co_lam_fn WpTyLam ids
-
-mkWpLams :: [Var] -> HsWrapper
-mkWpLams ids = mk_co_lam_fn WpEvLam ids
-
-mkWpLet :: TcEvBinds -> HsWrapper
--- This no-op is a quite a common case
-mkWpLet (EvBinds b) | isEmptyBag b = WpHole
-mkWpLet ev_binds = WpLet ev_binds
-
-mk_co_lam_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
-mk_co_lam_fn f as = foldr (\x wrap -> f x <.> wrap) WpHole as
-
-mk_co_app_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
--- For applications, the *first* argument must
--- come *last* in the composition sequence
-mk_co_app_fn f as = foldr (\x wrap -> wrap <.> f x) WpHole as
-
-idHsWrapper :: HsWrapper
-idHsWrapper = WpHole
-
-isIdHsWrapper :: HsWrapper -> Bool
-isIdHsWrapper WpHole = True
-isIdHsWrapper _ = False
-\end{code}
-
-
-%************************************************************************
-%* *
- Evidence bindings
-%* *
-%************************************************************************
-
-\begin{code}
-data TcEvBinds
- = TcEvBinds -- Mutable evidence bindings
- EvBindsVar -- Mutable because they are updated "later"
- -- when an implication constraint is solved
-
- | EvBinds -- Immutable after zonking
- (Bag EvBind)
-
- deriving( Data.Typeable )
-
-data EvBindsVar = EvBindsVar (IORef EvBindMap) Unique
- -- The Unique is only for debug printing
-
-instance Data.Data TcEvBinds where
- -- Placeholder; we can't travers into TcEvBinds
- toConstr _ = abstractConstr "TcEvBinds"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = Data.mkNoRepType "TcEvBinds"
-
------------------
-newtype EvBindMap
- = EvBindMap {
- ev_bind_varenv :: VarEnv EvBind
- } -- Map from evidence variables to evidence terms
-
-emptyEvBindMap :: EvBindMap
-emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyVarEnv }
-
-extendEvBinds :: EvBindMap -> EvVar -> EvTerm -> EvBindMap
-extendEvBinds bs v t
- = EvBindMap { ev_bind_varenv = extendVarEnv (ev_bind_varenv bs) v (EvBind v t) }
-
-lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind
-lookupEvBind bs = lookupVarEnv (ev_bind_varenv bs)
-
-evBindMapBinds :: EvBindMap -> Bag EvBind
-evBindMapBinds bs
- = foldVarEnv consBag emptyBag (ev_bind_varenv bs)
-
------------------
--- All evidence is bound by EvBinds; no side effects
-data EvBind = EvBind EvVar EvTerm
-
-data EvTerm
- = EvId EvId -- Term-level variable-to-variable bindings
- -- (no coercion variables! they come via EvCoercion)
-
- | EvCoercion TcCoercion -- (Boxed) coercion bindings
-
- | EvCast EvVar TcCoercion -- d |> co
-
- | EvDFunApp DFunId -- Dictionary instance application
- [Type] [EvVar]
-
- | EvTupleSel EvId Int -- n'th component of the tuple
-
- | EvTupleMk [EvId] -- tuple built from this stuff
-
- | EvDelayedError Type FastString -- Used with Opt_DeferTypeErrors
- -- See Note [Deferring coercion errors to runtime]
- -- in TcSimplify
-
- | EvSuperClass DictId Int -- n'th superclass. Used for both equalities and
- -- dictionaries, even though the former have no
- -- selector Id. We count up from _0_
- | EvKindCast EvVar TcCoercion -- See Note [EvKindCast]
+ go (ForAllTy tv ty) = mkTcForAllCo tv (go ty) + go (FunTy t1 t2) = mkTcFunCo (go t1) (go t2) +\end{code} + +Pretty printing + +\begin{code} +instance Outputable TcCoercion where + ppr = pprTcCo + +pprTcCo, pprParendTcCo :: TcCoercion -> SDoc +pprTcCo co = ppr_co TopPrec co +pprParendTcCo co = ppr_co TyConPrec co + +ppr_co :: Prec -> TcCoercion -> SDoc +ppr_co _ (TcRefl ty) = angleBrackets (ppr ty) + +ppr_co p co@(TcTyConAppCo tc [_,_]) + | tc `hasKey` funTyConKey = ppr_fun_co p co + +ppr_co p (TcTyConAppCo tc cos) = pprTcApp p ppr_co tc cos +ppr_co p (TcLetCo bs co) = maybeParen p TopPrec $ + sep [ptext (sLit "let") <+> braces (ppr bs), ppr co] +ppr_co p (TcAppCo co1 co2) = maybeParen p TyConPrec $ + pprTcCo co1 <+> ppr_co TyConPrec co2 +ppr_co p co@(TcForAllCo {}) = ppr_forall_co p co +ppr_co p (TcInstCo co ty) = maybeParen p TyConPrec $ + pprParendTcCo co <> ptext (sLit "@") <> pprType ty + +ppr_co _ (TcCoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv) +ppr_co p (TcAxiomInstCo con cos) = pprTypeNameApp p ppr_type (getName con) cos + +ppr_co p (TcTransCo co1 co2) = maybeParen p FunPrec $ + ppr_co FunPrec co1 + <+> ptext (sLit ";") + <+> ppr_co FunPrec co2 +ppr_co p (TcSymCo co) = pprPrefixApp p (ptext (sLit "Sym")) [pprParendTcCo co] +ppr_co p (TcNthCo n co) = pprPrefixApp p (ptext (sLit "Nth:") <+> int n) [pprParendTcCo co] + +ppr_fun_co :: Prec -> TcCoercion -> SDoc +ppr_fun_co p co = pprArrowChain p (split co) + where + split :: TcCoercion -> [SDoc] + split (TcTyConAppCo f [arg,res]) + | f `hasKey` funTyConKey + = ppr_co FunPrec arg : split res + split co = [ppr_co TopPrec co] + +ppr_forall_co :: Prec -> TcCoercion -> SDoc +ppr_forall_co p ty + = maybeParen p FunPrec $ + sep [pprForAll tvs, ppr_co TopPrec rho] + where + (tvs, rho) = split1 [] ty + split1 tvs (TcForAllCo tv ty) = split1 (tv:tvs) ty + split1 tvs ty = (reverse tvs, ty) +\end{code} + +%************************************************************************ +%* * + HsWrapper +%* * +%************************************************************************ + +\begin{code} +data HsWrapper + = WpHole -- The identity coercion + + | WpCompose HsWrapper HsWrapper + -- (wrap1 `WpCompose` wrap2)[e] = wrap1[ wrap2[ e ]] + -- + -- Hence (\a. []) `WpCompose` (\b. []) = (\a b. []) + -- But ([] a) `WpCompose` ([] b) = ([] b a) + + | WpCast TcCoercion -- A cast: [] `cast` co + -- Guaranteed not the identity coercion + + -- Evidence abstraction and application + -- (both dictionaries and coercions) + | WpEvLam EvVar -- \d. [] the 'd' is an evidence variable + | WpEvApp EvTerm -- [] d the 'd' is evidence for a constraint + + -- Kind and Type abstraction and application + | WpTyLam TyVar -- \a. [] the 'a' is a type/kind variable (not coercion var) + | WpTyApp KindOrType -- [] t the 't' is a type (not coercion) + + + | WpLet TcEvBinds -- Non-empty (or possibly non-empty) evidence bindings, + -- so that the identity coercion is always exactly WpHole + deriving (Data.Data, Data.Typeable) + + +(<.>) :: HsWrapper -> HsWrapper -> HsWrapper +WpHole <.> c = c +c <.> WpHole = c +c1 <.> c2 = c1 `WpCompose` c2 + +mkWpTyApps :: [Type] -> HsWrapper +mkWpTyApps tys = mk_co_app_fn WpTyApp tys + +mkWpEvApps :: [EvTerm] -> HsWrapper +mkWpEvApps args = mk_co_app_fn WpEvApp args + +mkWpEvVarApps :: [EvVar] -> HsWrapper +mkWpEvVarApps vs = mkWpEvApps (map EvId vs) + +mkWpTyLams :: [TyVar] -> HsWrapper +mkWpTyLams ids = mk_co_lam_fn WpTyLam ids + +mkWpLams :: [Var] -> HsWrapper +mkWpLams ids = mk_co_lam_fn WpEvLam ids + +mkWpLet :: TcEvBinds -> HsWrapper +-- This no-op is a quite a common case +mkWpLet (EvBinds b) | isEmptyBag b = WpHole +mkWpLet ev_binds = WpLet ev_binds + +mk_co_lam_fn :: (a -> HsWrapper) -> [a] -> HsWrapper +mk_co_lam_fn f as = foldr (\x wrap -> f x <.> wrap) WpHole as + +mk_co_app_fn :: (a -> HsWrapper) -> [a] -> HsWrapper +-- For applications, the *first* argument must +-- come *last* in the composition sequence +mk_co_app_fn f as = foldr (\x wrap -> wrap <.> f x) WpHole as + +idHsWrapper :: HsWrapper +idHsWrapper = WpHole + +isIdHsWrapper :: HsWrapper -> Bool +isIdHsWrapper WpHole = True +isIdHsWrapper _ = False +\end{code} + + +%************************************************************************ +%* * + Evidence bindings +%* * +%************************************************************************ + +\begin{code} +data TcEvBinds + = TcEvBinds -- Mutable evidence bindings + EvBindsVar -- Mutable because they are updated "later" + -- when an implication constraint is solved + + | EvBinds -- Immutable after zonking + (Bag EvBind) + + deriving( Data.Typeable ) + +data EvBindsVar = EvBindsVar (IORef EvBindMap) Unique + -- The Unique is only for debug printing + +instance Data.Data TcEvBinds where + -- Placeholder; we can't travers into TcEvBinds + toConstr _ = abstractConstr "TcEvBinds" + gunfold _ _ = error "gunfold" + dataTypeOf _ = Data.mkNoRepType "TcEvBinds" + +----------------- +newtype EvBindMap + = EvBindMap { + ev_bind_varenv :: VarEnv EvBind + } -- Map from evidence variables to evidence terms + +emptyEvBindMap :: EvBindMap +emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyVarEnv } + +extendEvBinds :: EvBindMap -> EvVar -> EvTerm -> EvBindMap +extendEvBinds bs v t + = EvBindMap { ev_bind_varenv = extendVarEnv (ev_bind_varenv bs) v (EvBind v t) } + +lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind +lookupEvBind bs = lookupVarEnv (ev_bind_varenv bs) + +evBindMapBinds :: EvBindMap -> Bag EvBind +evBindMapBinds bs + = foldVarEnv consBag emptyBag (ev_bind_varenv bs) + +----------------- +-- All evidence is bound by EvBinds; no side effects +data EvBind = EvBind EvVar EvTerm + +data EvTerm + = EvId EvId -- Term-level variable-to-variable bindings + -- (no coercion variables! they come via EvCoercion) + + | EvCoercion TcCoercion -- (Boxed) coercion bindings + + | EvCast EvVar TcCoercion -- d |> co + + | EvDFunApp DFunId -- Dictionary instance application + [Type] [EvVar] + + | EvTupleSel EvId Int -- n'th component of the tuple + + | EvTupleMk [EvId] -- tuple built from this stuff + + | EvDelayedError Type FastString -- Used with Opt_DeferTypeErrors + -- See Note [Deferring coercion errors to runtime] + -- in TcSimplify + + | EvSuperClass DictId Int -- n'th superclass. Used for both equalities and + -- dictionaries, even though the former have no + -- selector Id. We count up from _0_ + | EvKindCast EvVar TcCoercion -- See Note [EvKindCast] | EvInteger Integer -- The dictionary for class "NatI"
-- Note [EvInteger]
-
- deriving( Data.Data, Data.Typeable)
-\end{code}
-
-Note [EvKindCast]
-~~~~~~~~~~~~~~~~~
-
-EvKindCast g kco is produced when we have a constraint (g : s1 ~ s2)
-but the kinds of s1 and s2 (k1 and k2 respectively) don't match but
-are rather equal by a coercion. You may think that this coercion will
-always turn out to be ReflCo, so why is this needed? Because sometimes
-we will want to defer kind errors until the runtime and in these cases
-that coercion will be an 'error' term, which we want to evaluate rather
-than silently forget about!
-
-The relevant (and only) place where such a coercion is produced in
-the simplifier is in emit_kind_constraint in TcCanonical.
-
-
-Note [EvBinds/EvTerm]
-~~~~~~~~~~~~~~~~~~~~~
-How evidence is created and updated. Bindings for dictionaries,
-and coercions and implicit parameters are carried around in TcEvBinds
-which during constraint generation and simplification is always of the
-form (TcEvBinds ref). After constraint simplification is finished it
-will be transformed to t an (EvBinds ev_bag).
-
-Evidence for coercions *SHOULD* be filled in using the TcEvBinds
-However, all EvVars that correspond to *wanted* coercion terms in
-an EvBind must be mutable variables so that they can be readily
-inlined (by zonking) after constraint simplification is finished.
-
-Conclusion: a new wanted coercion variable should be made mutable.
-[Notice though that evidence variables that bind coercion terms
- from super classes will be "given" and hence rigid]
-
-
+ + deriving( Data.Data, Data.Typeable) +\end{code} + +Note [EvKindCast] +~~~~~~~~~~~~~~~~~ + +EvKindCast g kco is produced when we have a constraint (g : s1 ~ s2) +but the kinds of s1 and s2 (k1 and k2 respectively) don't match but +are rather equal by a coercion. You may think that this coercion will +always turn out to be ReflCo, so why is this needed? Because sometimes +we will want to defer kind errors until the runtime and in these cases +that coercion will be an 'error' term, which we want to evaluate rather +than silently forget about! + +The relevant (and only) place where such a coercion is produced in +the simplifier is in emit_kind_constraint in TcCanonical. + + +Note [EvBinds/EvTerm] +~~~~~~~~~~~~~~~~~~~~~ +How evidence is created and updated. Bindings for dictionaries, +and coercions and implicit parameters are carried around in TcEvBinds +which during constraint generation and simplification is always of the +form (TcEvBinds ref). After constraint simplification is finished it +will be transformed to t an (EvBinds ev_bag). + +Evidence for coercions *SHOULD* be filled in using the TcEvBinds +However, all EvVars that correspond to *wanted* coercion terms in +an EvBind must be mutable variables so that they can be readily +inlined (by zonking) after constraint simplification is finished. + +Conclusion: a new wanted coercion variable should be made mutable. +[Notice though that evidence variables that bind coercion terms + from super classes will be "given" and hence rigid] + + Note [EvInteger]
~~~~~~~~~~~~~~~~
A part of the type-level naturals implementation is the class "NatI",
@@ -542,97 +542,97 @@ one to make it into a "NatS" value, and another to make it into "NatI" evidence. -\begin{code}
-mkEvCast :: EvVar -> TcCoercion -> EvTerm
-mkEvCast ev lco
- | isTcReflCo lco = EvId ev
- | otherwise = EvCast ev lco
-
-mkEvKindCast :: EvVar -> TcCoercion -> EvTerm
-mkEvKindCast ev lco
- | isTcReflCo lco = EvId ev
- | otherwise = EvKindCast ev lco
-
-emptyTcEvBinds :: TcEvBinds
-emptyTcEvBinds = EvBinds emptyBag
-
-isEmptyTcEvBinds :: TcEvBinds -> Bool
-isEmptyTcEvBinds (EvBinds b) = isEmptyBag b
-isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds"
-
-
-evVarsOfTerm :: EvTerm -> [EvVar]
-evVarsOfTerm (EvId v) = [v]
-evVarsOfTerm (EvCoercion co) = varSetElems (coVarsOfTcCo co)
-evVarsOfTerm (EvDFunApp _ _ evs) = evs
-evVarsOfTerm (EvTupleSel v _) = [v]
-evVarsOfTerm (EvSuperClass v _) = [v]
-evVarsOfTerm (EvCast v co) = v : varSetElems (coVarsOfTcCo co)
-evVarsOfTerm (EvTupleMk evs) = evs
-evVarsOfTerm (EvDelayedError _ _) = []
-evVarsOfTerm (EvKindCast v co) = v : varSetElems (coVarsOfTcCo co)
+\begin{code} +mkEvCast :: EvVar -> TcCoercion -> EvTerm +mkEvCast ev lco + | isTcReflCo lco = EvId ev + | otherwise = EvCast ev lco + +mkEvKindCast :: EvVar -> TcCoercion -> EvTerm +mkEvKindCast ev lco + | isTcReflCo lco = EvId ev + | otherwise = EvKindCast ev lco + +emptyTcEvBinds :: TcEvBinds +emptyTcEvBinds = EvBinds emptyBag + +isEmptyTcEvBinds :: TcEvBinds -> Bool +isEmptyTcEvBinds (EvBinds b) = isEmptyBag b +isEmptyTcEvBinds (TcEvBinds {}) = panic "isEmptyTcEvBinds" + + +evVarsOfTerm :: EvTerm -> [EvVar] +evVarsOfTerm (EvId v) = [v] +evVarsOfTerm (EvCoercion co) = varSetElems (coVarsOfTcCo co) +evVarsOfTerm (EvDFunApp _ _ evs) = evs +evVarsOfTerm (EvTupleSel v _) = [v] +evVarsOfTerm (EvSuperClass v _) = [v] +evVarsOfTerm (EvCast v co) = v : varSetElems (coVarsOfTcCo co) +evVarsOfTerm (EvTupleMk evs) = evs +evVarsOfTerm (EvDelayedError _ _) = [] +evVarsOfTerm (EvKindCast v co) = v : varSetElems (coVarsOfTcCo co) evVarsOfTerm (EvInteger _) = []
-\end{code}
-
-
-%************************************************************************
-%* *
- Pretty printing
-%* *
-%************************************************************************
-
-\begin{code}
-instance Outputable HsWrapper where
- ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn
-
-pprHsWrapper :: SDoc -> HsWrapper -> SDoc
--- In debug mode, print the wrapper
--- otherwise just print what's inside
-pprHsWrapper doc wrap
- = getPprStyle (\ s -> if debugStyle s then (help (add_parens doc) wrap False) else doc)
- where
- help :: (Bool -> SDoc) -> HsWrapper -> Bool -> SDoc
- -- True <=> appears in function application position
- -- False <=> appears as body of let or lambda
- help it WpHole = it
- help it (WpCompose f1 f2) = help (help it f2) f1
- help it (WpCast co) = add_parens $ sep [it False, nest 2 (ptext (sLit "|>")
- <+> pprParendTcCo co)]
- help it (WpEvApp id) = no_parens $ sep [it True, nest 2 (ppr id)]
- help it (WpTyApp ty) = no_parens $ sep [it True, ptext (sLit "@") <+> pprParendType ty]
- help it (WpEvLam id) = add_parens $ sep [ ptext (sLit "\\") <> pp_bndr id, it False]
- help it (WpTyLam tv) = add_parens $ sep [ptext (sLit "/\\") <> pp_bndr tv, it False]
- help it (WpLet binds) = add_parens $ sep [ptext (sLit "let") <+> braces (ppr binds), it False]
-
- pp_bndr v = pprBndr LambdaBind v <> dot
-
- add_parens, no_parens :: SDoc -> Bool -> SDoc
- add_parens d True = parens d
- add_parens d False = d
- no_parens d _ = d
-
-instance Outputable TcEvBinds where
- ppr (TcEvBinds v) = ppr v
- ppr (EvBinds bs) = ptext (sLit "EvBinds") <> braces (vcat (map ppr (bagToList bs)))
-
-instance Outputable EvBindsVar where
- ppr (EvBindsVar _ u) = ptext (sLit "EvBindsVar") <> angleBrackets (ppr u)
-
-instance Outputable EvBind where
- ppr (EvBind v e) = sep [ ppr v, nest 2 $ equals <+> ppr e ]
- -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing
-
-instance Outputable EvTerm where
- ppr (EvId v) = ppr v
- ppr (EvCast v co) = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendTcCo co
- ppr (EvKindCast v co) = ppr v <+> (ptext (sLit "`kind-cast`")) <+> pprParendTcCo co
- ppr (EvCoercion co) = ptext (sLit "CO") <+> ppr co
- ppr (EvTupleSel v n) = ptext (sLit "tupsel") <> parens (ppr (v,n))
- ppr (EvTupleMk vs) = ptext (sLit "tupmk") <+> ppr vs
- ppr (EvSuperClass d n) = ptext (sLit "sc") <> parens (ppr (d,n))
- ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
- ppr (EvInteger n) = integer n
- ppr (EvDelayedError ty msg) = ptext (sLit "error")
- <+> sep [ char '@' <> ppr ty, ppr msg ]
-\end{code}
-
+\end{code} + + +%************************************************************************ +%* * + Pretty printing +%* * +%************************************************************************ + +\begin{code} +instance Outputable HsWrapper where + ppr co_fn = pprHsWrapper (ptext (sLit "<>")) co_fn + +pprHsWrapper :: SDoc -> HsWrapper -> SDoc +-- In debug mode, print the wrapper +-- otherwise just print what's inside +pprHsWrapper doc wrap + = getPprStyle (\ s -> if debugStyle s then (help (add_parens doc) wrap False) else doc) + where + help :: (Bool -> SDoc) -> HsWrapper -> Bool -> SDoc + -- True <=> appears in function application position + -- False <=> appears as body of let or lambda + help it WpHole = it + help it (WpCompose f1 f2) = help (help it f2) f1 + help it (WpCast co) = add_parens $ sep [it False, nest 2 (ptext (sLit "|>") + <+> pprParendTcCo co)] + help it (WpEvApp id) = no_parens $ sep [it True, nest 2 (ppr id)] + help it (WpTyApp ty) = no_parens $ sep [it True, ptext (sLit "@") <+> pprParendType ty] + help it (WpEvLam id) = add_parens $ sep [ ptext (sLit "\\") <> pp_bndr id, it False] + help it (WpTyLam tv) = add_parens $ sep [ptext (sLit "/\\") <> pp_bndr tv, it False] + help it (WpLet binds) = add_parens $ sep [ptext (sLit "let") <+> braces (ppr binds), it False] + + pp_bndr v = pprBndr LambdaBind v <> dot + + add_parens, no_parens :: SDoc -> Bool -> SDoc + add_parens d True = parens d + add_parens d False = d + no_parens d _ = d + +instance Outputable TcEvBinds where + ppr (TcEvBinds v) = ppr v + ppr (EvBinds bs) = ptext (sLit "EvBinds") <> braces (vcat (map ppr (bagToList bs))) + +instance Outputable EvBindsVar where + ppr (EvBindsVar _ u) = ptext (sLit "EvBindsVar") <> angleBrackets (ppr u) + +instance Outputable EvBind where + ppr (EvBind v e) = sep [ ppr v, nest 2 $ equals <+> ppr e ] + -- We cheat a bit and pretend EqVars are CoVars for the purposes of pretty printing + +instance Outputable EvTerm where + ppr (EvId v) = ppr v + ppr (EvCast v co) = ppr v <+> (ptext (sLit "`cast`")) <+> pprParendTcCo co + ppr (EvKindCast v co) = ppr v <+> (ptext (sLit "`kind-cast`")) <+> pprParendTcCo co + ppr (EvCoercion co) = ptext (sLit "CO") <+> ppr co + ppr (EvTupleSel v n) = ptext (sLit "tupsel") <> parens (ppr (v,n)) + ppr (EvTupleMk vs) = ptext (sLit "tupmk") <+> ppr vs + ppr (EvSuperClass d n) = ptext (sLit "sc") <> parens (ppr (d,n)) + ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ] + ppr (EvInteger n) = integer n + ppr (EvDelayedError ty msg) = ptext (sLit "error") + <+> sep [ char '@' <> ppr ty, ppr msg ] +\end{code} + diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs index a3b33bca60..abcff85d7d 100644 --- a/compiler/typecheck/TcExpr.lhs +++ b/compiler/typecheck/TcExpr.lhs @@ -325,7 +325,7 @@ tcExpr (SectionR op arg2) res_ty tcExpr (SectionL arg1 op) res_ty = do { (op', op_ty) <- tcInferFun op - ; dflags <- getDOpts -- Note [Left sections] + ; dflags <- getDynFlags -- Note [Left sections] ; let n_reqd_args | xopt Opt_PostfixOperators dflags = 1 | otherwise = 2 diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs index bf3bcbebe8..10de6acea5 100644 --- a/compiler/typecheck/TcForeign.lhs +++ b/compiler/typecheck/TcForeign.lhs @@ -246,14 +246,14 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar check False (illegalForeignTyErr empty sig_ty) return idecl (arg1_ty:arg_tys) -> do - dflags <- getDOpts + dflags <- getDynFlags check (isFFIDynArgumentTy arg1_ty) (illegalForeignTyErr argument arg1_ty) checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty return idecl | cconv == PrimCallConv = do - dflags <- getDOpts + dflags <- getDynFlags check (xopt Opt_GHCForeignImportPrim dflags) (text "Use -XGHCForeignImportPrim to allow `foreign import prim'.") checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp) @@ -268,7 +268,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar checkCg checkCOrAsmOrLlvmOrDotNetOrInterp checkCConv cconv checkCTarget target - dflags <- getDOpts + dflags <- getDynFlags checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty checkMissingAmpersand dflags arg_tys res_ty @@ -383,7 +383,7 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty -- Case for non-IO result type with FFI Import _ -> do - dflags <- getDOpts + dflags <- getDynFlags case (pred_res_ty ty && non_io_result_ok) of -- handle normal typecheck fail, we want to handle this first and -- only report safe haskell errors if the normal type check is OK. @@ -440,7 +440,7 @@ checkCOrAsmOrLlvmOrDotNetOrInterp _ checkCg :: (HscTarget -> Maybe SDoc) -> TcM () checkCg check = do - dflags <- getDOpts + dflags <- getDynFlags let target = hscTarget dflags case target of HscNothing -> return () @@ -456,7 +456,7 @@ Calling conventions checkCConv :: CCallConv -> TcM () checkCConv CCallConv = return () checkCConv CApiConv = return () -checkCConv StdCallConv = do dflags <- getDOpts +checkCConv StdCallConv = do dflags <- getDynFlags let platform = targetPlatform dflags unless (platformArch platform == ArchX86) $ -- This is a warning, not an error. see #3336 diff --git a/compiler/typecheck/TcGenGenerics.lhs b/compiler/typecheck/TcGenGenerics.lhs index 8bef05968f..1fbb7df856 100644 --- a/compiler/typecheck/TcGenGenerics.lhs +++ b/compiler/typecheck/TcGenGenerics.lhs @@ -117,7 +117,7 @@ genGenericRepExtras tc mod = genDtMeta :: (TyCon, MetaTyCons) -> TcM BagDerivStuff genDtMeta (tc,metaDts) = do loc <- getSrcSpanM - dflags <- getDOpts + dflags <- getDynFlags dClas <- tcLookupClass datatypeClassName let new_dfun_name clas tycon = newDFunName clas [mkTyConApp tycon []] loc d_dfun_name <- new_dfun_name dClas tc diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 6efc1028e2..6221bcd270 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -68,7 +68,7 @@ import NameSet import TysWiredIn import BasicTypes import SrcLoc -import DynFlags ( ExtensionFlag( Opt_PolyKinds ) ) +import DynFlags ( ExtensionFlag( Opt_DataKinds ) ) import Util import UniqSupply import Outputable @@ -1349,8 +1349,8 @@ sc_ds_var_app name arg_kis = do case mb_thing of Just (AGlobal (ATyCon tc)) | isAlgTyCon tc || isTupleTyCon tc -> do - poly_kinds <- xoptM Opt_PolyKinds - unless poly_kinds $ addErr (polyKindsErr name) + data_kinds <- xoptM Opt_DataKinds + unless data_kinds $ addErr (polyKindsErr name) let tc_kind = tyConKind tc case isPromotableKind tc_kind of Just n | n == length arg_kis -> diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index ac9769ca25..8351b7b52d 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/compiler/typecheck/TcInstDcls.lhs @@ -399,7 +399,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls -- Check that if the module is compiled with -XSafe, there are no -- hand written instances of Typeable as then unsafe casts could be -- performed. Derived instances are OK. - ; dflags <- getDOpts + ; dflags <- getDynFlags ; when (safeLanguageOn dflags) $ mapM_ (\x -> when (typInstCheck x) (addErrAt (getSrcSpan $ iSpec x) typInstErr)) @@ -716,7 +716,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) -- Deal with 'SPECIALISE instance' pragmas -- See Note [SPECIALISE instance pragmas] - ; spec_info@(spec_inst_prags,_) <- tcSpecInstPrags dfun_id ibinds + ; spec_inst_info <- tcSpecInstPrags dfun_id ibinds -- Typecheck the methods ; (meth_ids, meth_binds) @@ -725,7 +725,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) -- Those tyvars are inside the dfun_id's type, which is a bit -- bizarre, but OK so long as you realise it! tcInstanceMethods dfun_id clas inst_tyvars dfun_ev_vars - inst_tys spec_info + inst_tys spec_inst_info op_items ibinds -- Create the result bindings @@ -776,7 +776,8 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds }) map Var meth_ids export = ABE { abe_wrap = idHsWrapper, abe_poly = dfun_id_w_fun - , abe_mono = self_dict, abe_prags = SpecPrags spec_inst_prags } + , abe_mono = self_dict, abe_prags = noSpecPrags } + -- NB: noSpecPrags, see Note [SPECIALISE instance pragmas] main_bind = AbsBinds { abs_tvs = inst_tyvars , abs_ev_vars = dfun_ev_vars , abs_exports = [export] @@ -895,16 +896,12 @@ Consider range (x,y) = ... We do *not* want to make a specialised version of the dictionary -function. Rather, we want specialised versions of each method. +function. Rather, we want specialised versions of each *method*. Thus we should generate something like this: - $dfIx :: (Ix a, Ix x) => Ix (a,b) - {- DFUN [$crange, ...] -} - $dfIx da db = Ix ($crange da db) (...other methods...) - - $dfIxPair :: (Ix a, Ix x) => Ix (a,b) + $dfIxPair :: (Ix a, Ix b) => Ix (a,b) {- DFUN [$crangePair, ...] -} - $dfIxPair = Ix ($crangePair da db) (...other methods...) + $dfIxPair da db = Ix ($crangePair da db) (...other methods...) $crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)] {-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-} @@ -1067,14 +1064,22 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> TcSpecPrags -- Adapt the SPECIALISE pragmas to work for this method Id -- There are two sources: - -- * spec_inst_prags: {-# SPECIALISE instance :: <blah> #-} - -- These ones have the dfun inside, but [perhaps surprisingly] - -- the correct wrapper -- * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-} + -- * spec_prags_from_inst: derived from {-# SPECIALISE instance :: <blah> #-} + -- These ones have the dfun inside, but [perhaps surprisingly] + -- the correct wrapper. mk_meth_spec_prags meth_id spec_prags_for_me - = SpecPrags (spec_prags_for_me ++ - [ L loc (SpecPrag meth_id wrap inl) - | L loc (SpecPrag _ wrap inl) <- spec_inst_prags]) + = SpecPrags (spec_prags_for_me ++ spec_prags_from_inst) + where + spec_prags_from_inst + | isInlinePragma (idInlinePragma meth_id) + = [] -- Do not inherit SPECIALISE from the instance if the + -- method is marked INLINE, because then it'll be inlined + -- and the specialisation would do nothing. (Indeed it'll provoke + -- a warning from the desugarer + | otherwise + = [ L loc (SpecPrag meth_id wrap inl) + | L loc (SpecPrag _ wrap inl) <- spec_inst_prags] loc = getSrcSpan dfun_id sig_fn = mkSigFun sigs diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 3cc95a09f2..8e63ecf53b 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -99,35 +99,44 @@ solveInteractCts cts ; setTcSEvVarCacheMap new_evvar_cache ; updWorkListTcS (appendWorkListCt cts_thinner) >> solveInteract } - where add_cts_in_cache evvar_cache = foldM solve_or_cache ([],evvar_cache) - solve_or_cache :: ([Ct],TypeMap (EvVar,CtFlavor)) - -> Ct - -> TcS ([Ct],TypeMap (EvVar,CtFlavor)) - solve_or_cache (acc_cts,acc_cache) ct - | dont_cache (classifyPredType pred_ty) - = return (ct:acc_cts,acc_cache) - - | Just (ev',fl') <- lookupTM pred_ty acc_cache - , fl' `canSolve` fl - , isWanted fl - = do { _ <- setEvBind ev (EvId ev') fl - ; return (acc_cts,acc_cache) } - - | otherwise -- If it's a given keep it in the work list, even if it exists in the cache! - = return (ct:acc_cts, alterTM pred_ty (\_ -> Just (ev,fl)) acc_cache) - where fl = cc_flavor ct - ev = cc_id ct - pred_ty = ctPred ct - - dont_cache :: PredTree -> Bool - -- Do not use the cache, not update it, if this is true - dont_cache (IPPred {}) = True -- IPPreds have subtle shadowing - dont_cache (EqPred ty1 ty2) -- Report Int ~ Bool errors separately - | Just tc1 <- tyConAppTyCon_maybe ty1 - , Just tc2 <- tyConAppTyCon_maybe ty2 - , tc1 /= tc2 - = isDecomposableTyCon tc1 && isDecomposableTyCon tc2 - dont_cache _ = False + where + add_cts_in_cache evvar_cache cts + = do { ctxt <- getTcSContext + ; foldM (solve_or_cache (simplEqsOnly ctxt)) ([],evvar_cache) cts } + + solve_or_cache :: Bool -- Solve equalities only, not classes etc + -> ([Ct],TypeMap (EvVar,CtFlavor)) + -> Ct + -> TcS ([Ct],TypeMap (EvVar,CtFlavor)) + solve_or_cache eqs_only (acc_cts,acc_cache) ct + | dont_cache eqs_only (classifyPredType pred_ty) + = return (ct:acc_cts,acc_cache) + + | Just (ev',fl') <- lookupTM pred_ty acc_cache + , fl' `canSolve` fl + , isWanted fl + = do { _ <- setEvBind ev (EvId ev') fl + ; return (acc_cts,acc_cache) } + + | otherwise -- If it's a given keep it in the work list, even if it exists in the cache! + = return (ct:acc_cts, alterTM pred_ty (\_ -> Just (ev,fl)) acc_cache) + where fl = cc_flavor ct + ev = cc_id ct + pred_ty = ctPred ct + + dont_cache :: Bool -> PredTree -> Bool + -- Do not use the cache, not update it, if this is true + dont_cache _ (IPPred {}) = True -- IPPreds have subtle shadowing + dont_cache _ (EqPred ty1 ty2) -- Report Int ~ Bool errors separately + | Just tc1 <- tyConAppTyCon_maybe ty1 + , Just tc2 <- tyConAppTyCon_maybe ty2 + , tc1 /= tc2 + = isDecomposableTyCon tc1 && isDecomposableTyCon tc2 + | otherwise = False + dont_cache eqs_only _ = eqs_only + -- If we are simplifying equalities only, + -- do not cache non-equalities + -- See Note [Simplifying RULE lhs constraints] in TcSimplify solveInteractGiven :: GivenLoc -> [EvVar] -> TcS () solveInteractGiven gloc evs diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index e131c3d1a2..48ad6e379d 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -1184,7 +1184,7 @@ check_valid_theta :: UserTypeCtxt -> [PredType] -> TcM () check_valid_theta _ [] = return () check_valid_theta ctxt theta = do - dflags <- getDOpts + dflags <- getDynFlags warnTc (notNull dups) (dupPredWarn dups) mapM_ (check_pred_ty dflags ctxt) theta where @@ -1491,7 +1491,7 @@ We can also have instances for functions: @instance Foo (a -> b) ...@. \begin{code} checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM () checkValidInstHead ctxt clas tys - = do { dflags <- getDOpts + = do { dflags <- getDynFlags -- Check language restrictions; -- but not for SPECIALISE isntance pragmas diff --git a/compiler/typecheck/TcMatches.lhs b/compiler/typecheck/TcMatches.lhs index 333c2d0984..acdc8389be 100644 --- a/compiler/typecheck/TcMatches.lhs +++ b/compiler/typecheck/TcMatches.lhs @@ -804,7 +804,7 @@ tcDoStmt ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names = do { let tup_names = rec_names ++ filterOut (`elem` rec_names) later_names ; tup_elt_tys <- newFlexiTyVarTys (length tup_names) liftedTypeKind ; let tup_ids = zipWith mkLocalId tup_names tup_elt_tys - tup_ty = mkBoxedTupleTy tup_elt_tys + tup_ty = mkBigCoreTupTy tup_elt_tys ; tcExtendIdEnv tup_ids $ do { stmts_ty <- newFlexiTyVarTy liftedTypeKind diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 4e46de90d9..908588b8f6 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -983,7 +983,7 @@ checkMain :: TcM TcGblEnv -- If we are in module Main, check that 'main' is defined. checkMain = do { tcg_env <- getGblEnv ; - dflags <- getDOpts ; + dflags <- getDynFlags ; check_main dflags tcg_env } @@ -1065,7 +1065,7 @@ getMainFun dflags = case (mainFunIs dflags) of checkMainExported :: TcGblEnv -> TcM () checkMainExported tcg_env = do - dflags <- getDOpts + dflags <- getDynFlags case tcg_main tcg_env of Nothing -> return () -- not the main module Just main_name -> do @@ -1677,7 +1677,7 @@ rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) } tcDump :: TcGblEnv -> TcRn () tcDump env - = do { dflags <- getDOpts ; + = do { dflags <- getDynFlags ; -- Dump short output if -ddump-types or -ddump-tc when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags) @@ -1694,7 +1694,7 @@ tcDump env tcCoreDump :: ModGuts -> TcM () tcCoreDump mod_guts - = do { dflags <- getDOpts ; + = do { dflags <- getDynFlags ; when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags) (dumpTcRn (pprModGuts mod_guts)) ; diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 2c6461fef9..351a3e25d0 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -254,17 +254,14 @@ setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl = Command-line flags \begin{code} -getDOpts :: TcRnIf gbl lcl DynFlags -getDOpts = do { env <- getTopEnv; return (hsc_dflags env) } - xoptM :: ExtensionFlag -> TcRnIf gbl lcl Bool -xoptM flag = do { dflags <- getDOpts; return (xopt flag dflags) } +xoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) } doptM :: DynFlag -> TcRnIf gbl lcl Bool -doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) } +doptM flag = do { dflags <- getDynFlags; return (dopt flag dflags) } woptM :: WarningFlag -> TcRnIf gbl lcl Bool -woptM flag = do { dflags <- getDOpts; return (wopt flag dflags) } +woptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) } setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updEnv (\ env@(Env { env_top = top }) -> @@ -457,7 +454,7 @@ traceOptTcRn flag doc = ifDOptM flag $ do dumpTcRn :: SDoc -> TcRn () dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv - ; dflags <- getDOpts + ; dflags <- getDynFlags ; liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) } debugDumpTcRn :: SDoc -> TcRn () @@ -626,7 +623,7 @@ mkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ErrMsg mkLongErrAt loc msg extra = do { traceTc "Adding error:" (mkLocMessage SevError loc (msg $$ extra)) ; rdr_env <- getGlobalRdrEnv ; - dflags <- getDOpts ; + dflags <- getDynFlags ; return $ mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra } addLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn () @@ -649,7 +646,7 @@ reportWarning warn dumpDerivingInfo :: SDoc -> TcM () dumpDerivingInfo doc - = do { dflags <- getDOpts + = do { dflags <- getDynFlags ; when (dopt Opt_D_dump_deriv dflags) $ do { rdr_env <- getGlobalRdrEnv ; let unqual = mkPrintUnqualified dflags rdr_env @@ -719,7 +716,7 @@ tryTcErrs :: TcRn a -> TcRn (Messages, Maybe a) -- there might be warnings tryTcErrs thing = do { (msgs, res) <- tryTc thing - ; dflags <- getDOpts + ; dflags <- getDynFlags ; let errs_found = errorsFound dflags msgs ; return (msgs, case res of Nothing -> Nothing @@ -775,7 +772,7 @@ ifErrsM :: TcRn r -> TcRn r -> TcRn r ifErrsM bale_out normal = do { errs_var <- getErrsVar ; msgs <- readTcRef errs_var ; - dflags <- getDOpts ; + dflags <- getDynFlags ; if errorsFound dflags msgs then bale_out else @@ -908,7 +905,7 @@ add_warn msg extra_info add_warn_at :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn () add_warn_at loc msg extra_info = do { rdr_env <- getGlobalRdrEnv ; - dflags <- getDOpts ; + dflags <- getDynFlags ; let { warn = mkLongWarnMsg loc (mkPrintUnqualified dflags rdr_env) msg extra_info } ; reportWarning warn } diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 015510fb3f..8ff3ce3f76 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -116,6 +116,7 @@ import UniqSupply import Unique import BasicTypes import Bag +import DynFlags import Outputable import ListSetOps import FastString @@ -187,6 +188,9 @@ data Env gbl lcl env_lcl :: lcl -- Nested stuff; changes as we go into } +instance ContainsDynFlags (Env gbl lcl) where + extractDynFlags env = hsc_dflags (env_top env) + -- TcGblEnv describes the top-level of the module at the -- point at which the typechecker is finished work. -- It is this structure that is handed on to the desugarer diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index 240ba9c017..660007d7c5 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -923,7 +923,7 @@ emitFrozenError fl ev depth ; wrapTcS (TcM.writeTcRef inert_ref inerts_new) } instance HasDynFlags TcS where - getDynFlags = wrapTcS TcM.getDOpts + getDynFlags = wrapTcS getDynFlags getTcSContext :: TcS SimplContext getTcSContext = TcS (return . tcs_context) diff --git a/compiler/typecheck/TcSimplify.lhs-old b/compiler/typecheck/TcSimplify.lhs-old deleted file mode 100644 index 274c14d70b..0000000000 --- a/compiler/typecheck/TcSimplify.lhs-old +++ /dev/null @@ -1,3297 +0,0 @@ -% -% (c) The University of Glasgow 2006 -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% - -TcSimplify - -\begin{code} -module TcSimplify ( - tcSimplifyInfer, tcSimplifyInferCheck, - tcSimplifyCheck, tcSimplifyRestricted, - tcSimplifyRuleLhs, tcSimplifyIPs, - tcSimplifySuperClasses, - tcSimplifyTop, tcSimplifyInteractive, - tcSimplifyBracket, tcSimplifyCheckPat, - - tcSimplifyDeriv, tcSimplifyDefault, - bindInstsOfLocalFuns, - - misMatchMsg - ) where - -#include "HsVersions.h" - -import {-# SOURCE #-} TcUnify( unifyType ) -import HsSyn - -import TcRnMonad -import TcHsSyn ( hsLPatType ) -import Inst -import TcEnv -import InstEnv -import TcType -import TcMType -import TcIface -import TcTyFuns -import DsUtils -- Big-tuple functions -import Var -import Id -import Name -import NameSet -import Class -import FunDeps -import PrelInfo -import PrelNames -import TysWiredIn -import ErrUtils -import BasicTypes -import VarSet -import VarEnv -import FiniteMap -import Bag -import Outputable -import ListSetOps -import Util -import SrcLoc -import DynFlags -import FastString - -import Control.Monad -import Data.List -\end{code} - - -%************************************************************************ -%* * -\subsection{NOTES} -%* * -%************************************************************************ - - -------------------------------------- - Notes on functional dependencies (a bug) - -------------------------------------- - -Consider this: - - class C a b | a -> b - class D a b | a -> b - - instance D a b => C a b -- Undecidable - -- (Not sure if it's crucial to this eg) - f :: C a b => a -> Bool - f _ = True - - g :: C a b => a -> Bool - g = f - -Here f typechecks, but g does not!! Reason: before doing improvement, -we reduce the (C a b1) constraint from the call of f to (D a b1). - -Here is a more complicated example: - -@ - > class Foo a b | a->b - > - > class Bar a b | a->b - > - > data Obj = Obj - > - > instance Bar Obj Obj - > - > instance (Bar a b) => Foo a b - > - > foo:: (Foo a b) => a -> String - > foo _ = "works" - > - > runFoo:: (forall a b. (Foo a b) => a -> w) -> w - > runFoo f = f Obj - - *Test> runFoo foo - - <interactive>:1: - Could not deduce (Bar a b) from the context (Foo a b) - arising from use of `foo' at <interactive>:1 - Probable fix: - Add (Bar a b) to the expected type of an expression - In the first argument of `runFoo', namely `foo' - In the definition of `it': it = runFoo foo - - Why all of the sudden does GHC need the constraint Bar a b? The - function foo didn't ask for that... -@ - -The trouble is that to type (runFoo foo), GHC has to solve the problem: - - Given constraint Foo a b - Solve constraint Foo a b' - -Notice that b and b' aren't the same. To solve this, just do -improvement and then they are the same. But GHC currently does - simplify constraints - apply improvement - and loop - -That is usually fine, but it isn't here, because it sees that Foo a b is -not the same as Foo a b', and so instead applies the instance decl for -instance Bar a b => Foo a b. And that's where the Bar constraint comes -from. - -The Right Thing is to improve whenever the constraint set changes at -all. Not hard in principle, but it'll take a bit of fiddling to do. - -Note [Choosing which variables to quantify] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we are about to do a generalisation step. We have in our hand - - G the environment - T the type of the RHS - C the constraints from that RHS - -The game is to figure out - - Q the set of type variables over which to quantify - Ct the constraints we will *not* quantify over - Cq the constraints we will quantify over - -So we're going to infer the type - - forall Q. Cq => T - -and float the constraints Ct further outwards. - -Here are the things that *must* be true: - - (A) Q intersect fv(G) = EMPTY limits how big Q can be - (B) Q superset fv(Cq union T) \ oclose(fv(G),C) limits how small Q can be - - (A) says we can't quantify over a variable that's free in the environment. - (B) says we must quantify over all the truly free variables in T, else - we won't get a sufficiently general type. - -We do not *need* to quantify over any variable that is fixed by the -free vars of the environment G. - - BETWEEN THESE TWO BOUNDS, ANY Q WILL DO! - -Example: class H x y | x->y where ... - - fv(G) = {a} C = {H a b, H c d} - T = c -> b - - (A) Q intersect {a} is empty - (B) Q superset {a,b,c,d} \ oclose({a}, C) = {a,b,c,d} \ {a,b} = {c,d} - - So Q can be {c,d}, {b,c,d} - -In particular, it's perfectly OK to quantify over more type variables -than strictly necessary; there is no need to quantify over 'b', since -it is determined by 'a' which is free in the envt, but it's perfectly -OK to do so. However we must not quantify over 'a' itself. - -Other things being equal, however, we'd like to quantify over as few -variables as possible: smaller types, fewer type applications, more -constraints can get into Ct instead of Cq. Here's a good way to -choose Q: - - Q = grow( fv(T), C ) \ oclose( fv(G), C ) - -That is, quantify over all variable that that MIGHT be fixed by the -call site (which influences T), but which aren't DEFINITELY fixed by -G. This choice definitely quantifies over enough type variables, -albeit perhaps too many. - -Why grow( fv(T), C ) rather than fv(T)? Consider - - class H x y | x->y where ... - - T = c->c - C = (H c d) - - If we used fv(T) = {c} we'd get the type - - forall c. H c d => c -> b - - And then if the fn was called at several different c's, each of - which fixed d differently, we'd get a unification error, because - d isn't quantified. Solution: quantify d. So we must quantify - everything that might be influenced by c. - -Why not oclose( fv(T), C )? Because we might not be able to see -all the functional dependencies yet: - - class H x y | x->y where ... - instance H x y => Eq (T x y) where ... - - T = c->c - C = (Eq (T c d)) - -Now oclose(fv(T),C) = {c}, because the functional dependency isn't -apparent yet, and that's wrong. We must really quantify over d too. - -There really isn't any point in quantifying over any more than -grow( fv(T), C ), because the call sites can't possibly influence -any other type variables. - - - -------------------------------------- - Note [Ambiguity] -------------------------------------- - -It's very hard to be certain when a type is ambiguous. Consider - - class K x - class H x y | x -> y - instance H x y => K (x,y) - -Is this type ambiguous? - forall a b. (K (a,b), Eq b) => a -> a - -Looks like it! But if we simplify (K (a,b)) we get (H a b) and -now we see that a fixes b. So we can't tell about ambiguity for sure -without doing a full simplification. And even that isn't possible if -the context has some free vars that may get unified. Urgle! - -Here's another example: is this ambiguous? - forall a b. Eq (T b) => a -> a -Not if there's an insance decl (with no context) - instance Eq (T b) where ... - -You may say of this example that we should use the instance decl right -away, but you can't always do that: - - class J a b where ... - instance J Int b where ... - - f :: forall a b. J a b => a -> a - -(Notice: no functional dependency in J's class decl.) -Here f's type is perfectly fine, provided f is only called at Int. -It's premature to complain when meeting f's signature, or even -when inferring a type for f. - - - -However, we don't *need* to report ambiguity right away. It'll always -show up at the call site.... and eventually at main, which needs special -treatment. Nevertheless, reporting ambiguity promptly is an excellent thing. - -So here's the plan. We WARN about probable ambiguity if - - fv(Cq) is not a subset of oclose(fv(T) union fv(G), C) - -(all tested before quantification). -That is, all the type variables in Cq must be fixed by the the variables -in the environment, or by the variables in the type. - -Notice that we union before calling oclose. Here's an example: - - class J a b c | a b -> c - fv(G) = {a} - -Is this ambiguous? - forall b c. (J a b c) => b -> b - -Only if we union {a} from G with {b} from T before using oclose, -do we see that c is fixed. - -It's a bit vague exactly which C we should use for this oclose call. If we -don't fix enough variables we might complain when we shouldn't (see -the above nasty example). Nothing will be perfect. That's why we can -only issue a warning. - - -Can we ever be *certain* about ambiguity? Yes: if there's a constraint - - c in C such that fv(c) intersect (fv(G) union fv(T)) = EMPTY - -then c is a "bubble"; there's no way it can ever improve, and it's -certainly ambiguous. UNLESS it is a constant (sigh). And what about -the nasty example? - - class K x - class H x y | x -> y - instance H x y => K (x,y) - -Is this type ambiguous? - forall a b. (K (a,b), Eq b) => a -> a - -Urk. The (Eq b) looks "definitely ambiguous" but it isn't. What we are after -is a "bubble" that's a set of constraints - - Cq = Ca union Cq' st fv(Ca) intersect (fv(Cq') union fv(T) union fv(G)) = EMPTY - -Hence another idea. To decide Q start with fv(T) and grow it -by transitive closure in Cq (no functional dependencies involved). -Now partition Cq using Q, leaving the definitely-ambiguous and probably-ok. -The definitely-ambiguous can then float out, and get smashed at top level -(which squashes out the constants, like Eq (T a) above) - - - -------------------------------------- - Notes on principal types - -------------------------------------- - - class C a where - op :: a -> a - - f x = let g y = op (y::Int) in True - -Here the principal type of f is (forall a. a->a) -but we'll produce the non-principal type - f :: forall a. C Int => a -> a - - - -------------------------------------- - The need for forall's in constraints - -------------------------------------- - -[Exchange on Haskell Cafe 5/6 Dec 2000] - - class C t where op :: t -> Bool - instance C [t] where op x = True - - p y = (let f :: c -> Bool; f x = op (y >> return x) in f, y ++ []) - q y = (y ++ [], let f :: c -> Bool; f x = op (y >> return x) in f) - -The definitions of p and q differ only in the order of the components in -the pair on their right-hand sides. And yet: - - ghc and "Typing Haskell in Haskell" reject p, but accept q; - Hugs rejects q, but accepts p; - hbc rejects both p and q; - nhc98 ... (Malcolm, can you fill in the blank for us!). - -The type signature for f forces context reduction to take place, and -the results of this depend on whether or not the type of y is known, -which in turn depends on which component of the pair the type checker -analyzes first. - -Solution: if y::m a, float out the constraints - Monad m, forall c. C (m c) -When m is later unified with [], we can solve both constraints. - - - -------------------------------------- - Notes on implicit parameters - -------------------------------------- - -Note [Inheriting implicit parameters] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this: - - f x = (x::Int) + ?y - -where f is *not* a top-level binding. -From the RHS of f we'll get the constraint (?y::Int). -There are two types we might infer for f: - - f :: Int -> Int - -(so we get ?y from the context of f's definition), or - - f :: (?y::Int) => Int -> Int - -At first you might think the first was better, becuase then -?y behaves like a free variable of the definition, rather than -having to be passed at each call site. But of course, the WHOLE -IDEA is that ?y should be passed at each call site (that's what -dynamic binding means) so we'd better infer the second. - -BOTTOM LINE: when *inferring types* you *must* quantify -over implicit parameters. See the predicate isFreeWhenInferring. - - -Note [Implicit parameters and ambiguity] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Only a *class* predicate can give rise to ambiguity -An *implicit parameter* cannot. For example: - foo :: (?x :: [a]) => Int - foo = length ?x -is fine. The call site will suppply a particular 'x' - -Furthermore, the type variables fixed by an implicit parameter -propagate to the others. E.g. - foo :: (Show a, ?x::[a]) => Int - foo = show (?x++?x) -The type of foo looks ambiguous. But it isn't, because at a call site -we might have - let ?x = 5::Int in foo -and all is well. In effect, implicit parameters are, well, parameters, -so we can take their type variables into account as part of the -"tau-tvs" stuff. This is done in the function 'FunDeps.grow'. - - -Question 2: type signatures -~~~~~~~~~~~~~~~~~~~~~~~~~~~ -BUT WATCH OUT: When you supply a type signature, we can't force you -to quantify over implicit parameters. For example: - - (?x + 1) :: Int - -This is perfectly reasonable. We do not want to insist on - - (?x + 1) :: (?x::Int => Int) - -That would be silly. Here, the definition site *is* the occurrence site, -so the above strictures don't apply. Hence the difference between -tcSimplifyCheck (which *does* allow implicit paramters to be inherited) -and tcSimplifyCheckBind (which does not). - -What about when you supply a type signature for a binding? -Is it legal to give the following explicit, user type -signature to f, thus: - - f :: Int -> Int - f x = (x::Int) + ?y - -At first sight this seems reasonable, but it has the nasty property -that adding a type signature changes the dynamic semantics. -Consider this: - - (let f x = (x::Int) + ?y - in (f 3, f 3 with ?y=5)) with ?y = 6 - - returns (3+6, 3+5) -vs - (let f :: Int -> Int - f x = x + ?y - in (f 3, f 3 with ?y=5)) with ?y = 6 - - returns (3+6, 3+6) - -Indeed, simply inlining f (at the Haskell source level) would change the -dynamic semantics. - -Nevertheless, as Launchbury says (email Oct 01) we can't really give the -semantics for a Haskell program without knowing its typing, so if you -change the typing you may change the semantics. - -To make things consistent in all cases where we are *checking* against -a supplied signature (as opposed to inferring a type), we adopt the -rule: - - a signature does not need to quantify over implicit params. - -[This represents a (rather marginal) change of policy since GHC 5.02, -which *required* an explicit signature to quantify over all implicit -params for the reasons mentioned above.] - -But that raises a new question. Consider - - Given (signature) ?x::Int - Wanted (inferred) ?x::Int, ?y::Bool - -Clearly we want to discharge the ?x and float the ?y out. But -what is the criterion that distinguishes them? Clearly it isn't -what free type variables they have. The Right Thing seems to be -to float a constraint that - neither mentions any of the quantified type variables - nor any of the quantified implicit parameters - -See the predicate isFreeWhenChecking. - - -Question 3: monomorphism -~~~~~~~~~~~~~~~~~~~~~~~~ -There's a nasty corner case when the monomorphism restriction bites: - - z = (x::Int) + ?y - -The argument above suggests that we *must* generalise -over the ?y parameter, to get - z :: (?y::Int) => Int, -but the monomorphism restriction says that we *must not*, giving - z :: Int. -Why does the momomorphism restriction say this? Because if you have - - let z = x + ?y in z+z - -you might not expect the addition to be done twice --- but it will if -we follow the argument of Question 2 and generalise over ?y. - - -Question 4: top level -~~~~~~~~~~~~~~~~~~~~~ -At the top level, monomorhism makes no sense at all. - - module Main where - main = let ?x = 5 in print foo - - foo = woggle 3 - - woggle :: (?x :: Int) => Int -> Int - woggle y = ?x + y - -We definitely don't want (foo :: Int) with a top-level implicit parameter -(?x::Int) becuase there is no way to bind it. - - -Possible choices -~~~~~~~~~~~~~~~~ -(A) Always generalise over implicit parameters - Bindings that fall under the monomorphism restriction can't - be generalised - - Consequences: - * Inlining remains valid - * No unexpected loss of sharing - * But simple bindings like - z = ?y + 1 - will be rejected, unless you add an explicit type signature - (to avoid the monomorphism restriction) - z :: (?y::Int) => Int - z = ?y + 1 - This seems unacceptable - -(B) Monomorphism restriction "wins" - Bindings that fall under the monomorphism restriction can't - be generalised - Always generalise over implicit parameters *except* for bindings - that fall under the monomorphism restriction - - Consequences - * Inlining isn't valid in general - * No unexpected loss of sharing - * Simple bindings like - z = ?y + 1 - accepted (get value of ?y from binding site) - -(C) Always generalise over implicit parameters - Bindings that fall under the monomorphism restriction can't - be generalised, EXCEPT for implicit parameters - Consequences - * Inlining remains valid - * Unexpected loss of sharing (from the extra generalisation) - * Simple bindings like - z = ?y + 1 - accepted (get value of ?y from occurrence sites) - - -Discussion -~~~~~~~~~~ -None of these choices seems very satisfactory. But at least we should -decide which we want to do. - -It's really not clear what is the Right Thing To Do. If you see - - z = (x::Int) + ?y - -would you expect the value of ?y to be got from the *occurrence sites* -of 'z', or from the valuue of ?y at the *definition* of 'z'? In the -case of function definitions, the answer is clearly the former, but -less so in the case of non-fucntion definitions. On the other hand, -if we say that we get the value of ?y from the definition site of 'z', -then inlining 'z' might change the semantics of the program. - -Choice (C) really says "the monomorphism restriction doesn't apply -to implicit parameters". Which is fine, but remember that every -innocent binding 'x = ...' that mentions an implicit parameter in -the RHS becomes a *function* of that parameter, called at each -use of 'x'. Now, the chances are that there are no intervening 'with' -clauses that bind ?y, so a decent compiler should common up all -those function calls. So I think I strongly favour (C). Indeed, -one could make a similar argument for abolishing the monomorphism -restriction altogether. - -BOTTOM LINE: we choose (B) at present. See tcSimplifyRestricted - - - -%************************************************************************ -%* * -\subsection{tcSimplifyInfer} -%* * -%************************************************************************ - -tcSimplify is called when we *inferring* a type. Here's the overall game plan: - - 1. Compute Q = grow( fvs(T), C ) - - 2. Partition C based on Q into Ct and Cq. Notice that ambiguous - predicates will end up in Ct; we deal with them at the top level - - 3. Try improvement, using functional dependencies - - 4. If Step 3 did any unification, repeat from step 1 - (Unification can change the result of 'grow'.) - -Note: we don't reduce dictionaries in step 2. For example, if we have -Eq (a,b), we don't simplify to (Eq a, Eq b). So Q won't be different -after step 2. However note that we may therefore quantify over more -type variables than we absolutely have to. - -For the guts, we need a loop, that alternates context reduction and -improvement with unification. E.g. Suppose we have - - class C x y | x->y where ... - -and tcSimplify is called with: - (C Int a, C Int b) -Then improvement unifies a with b, giving - (C Int a, C Int a) - -If we need to unify anything, we rattle round the whole thing all over -again. - - -\begin{code} -tcSimplifyInfer - :: SDoc - -> TcTyVarSet -- fv(T); type vars - -> [Inst] -- Wanted - -> TcM ([TcTyVar], -- Tyvars to quantify (zonked and quantified) - [Inst], -- Dict Ids that must be bound here (zonked) - TcDictBinds) -- Bindings - -- Any free (escaping) Insts are tossed into the environment -\end{code} - - -\begin{code} -tcSimplifyInfer doc tau_tvs wanted - = do { tau_tvs1 <- zonkTcTyVarsAndFV (varSetElems tau_tvs) - ; wanted' <- mapM zonkInst wanted -- Zonk before deciding quantified tyvars - ; gbl_tvs <- tcGetGlobalTyVars - ; let preds1 = fdPredsOfInsts wanted' - gbl_tvs1 = oclose preds1 gbl_tvs - qtvs = growInstsTyVars wanted' tau_tvs1 `minusVarSet` gbl_tvs1 - -- See Note [Choosing which variables to quantify] - - -- To maximise sharing, remove from consideration any - -- constraints that don't mention qtvs at all - ; let (free, bound) = partition (isFreeWhenInferring qtvs) wanted' - ; extendLIEs free - - -- To make types simple, reduce as much as possible - ; traceTc (text "infer" <+> (ppr preds1 $$ ppr (growInstsTyVars wanted' tau_tvs1) $$ ppr gbl_tvs $$ - ppr gbl_tvs1 $$ ppr free $$ ppr bound)) - ; (irreds1, binds1) <- tryHardCheckLoop doc bound - - -- Note [Inference and implication constraints] - ; let want_dict d = tyVarsOfInst d `intersectsVarSet` qtvs - ; (irreds2, binds2) <- approximateImplications doc want_dict irreds1 - - -- Now work out all over again which type variables to quantify, - -- exactly in the same way as before, but starting from irreds2. Why? - -- a) By now improvment may have taken place, and we must *not* - -- quantify over any variable free in the environment - -- tc137 (function h inside g) is an example - -- - -- b) Do not quantify over constraints that *now* do not - -- mention quantified type variables, because they are - -- simply ambiguous (or might be bound further out). Example: - -- f :: Eq b => a -> (a, b) - -- g x = fst (f x) - -- From the RHS of g we get the MethodInst f77 :: alpha -> (alpha, beta) - -- We decide to quantify over 'alpha' alone, but free1 does not include f77 - -- because f77 mentions 'alpha'. Then reducing leaves only the (ambiguous) - -- constraint (Eq beta), which we dump back into the free set - -- See test tcfail181 - -- - -- c) irreds may contain type variables not previously mentioned, - -- e.g. instance D a x => Foo [a] - -- wanteds = Foo [a] - -- Then after simplifying we'll get (D a x), and x is fresh - -- We must quantify over x else it'll be totally unbound - ; tau_tvs2 <- zonkTcTyVarsAndFV (varSetElems tau_tvs1) - ; gbl_tvs2 <- zonkTcTyVarsAndFV (varSetElems gbl_tvs1) - -- Note that we start from gbl_tvs1 - -- We use tcGetGlobalTyVars, then oclose wrt preds2, because - -- we've already put some of the original preds1 into frees - -- E.g. wanteds = C a b (where a->b) - -- gbl_tvs = {a} - -- tau_tvs = {b} - -- Then b is fixed by gbl_tvs, so (C a b) will be in free, and - -- irreds2 will be empty. But we don't want to generalise over b! - ; let preds2 = fdPredsOfInsts irreds2 -- irreds2 is zonked - qtvs = growInstsTyVars irreds2 tau_tvs2 `minusVarSet` oclose preds2 gbl_tvs2 - --------------------------------------------------- - -- BUG WARNING: there's a nasty bug lurking here - -- fdPredsOfInsts may return preds that mention variables quantified in - -- one of the implication constraints in irreds2; and that is clearly wrong: - -- we might quantify over too many variables through accidental capture - --------------------------------------------------- - ; let (free, irreds3) = partition (isFreeWhenInferring qtvs) irreds2 - ; extendLIEs free - - -- Turn the quantified meta-type variables into real type variables - ; qtvs2 <- zonkQuantifiedTyVars (varSetElems qtvs) - - -- We can't abstract over any remaining unsolved - -- implications so instead just float them outwards. Ugh. - ; let (q_dicts0, implics) = partition isAbstractableInst irreds3 - ; loc <- getInstLoc (ImplicOrigin doc) - ; implic_bind <- bindIrreds loc qtvs2 q_dicts0 implics - - -- Prepare equality instances for quantification - ; let (q_eqs0,q_dicts) = partition isEqInst q_dicts0 - ; q_eqs <- mapM finalizeEqInst q_eqs0 - - ; return (qtvs2, q_eqs ++ q_dicts, binds1 `unionBags` binds2 `unionBags` implic_bind) } - -- NB: when we are done, we might have some bindings, but - -- the final qtvs might be empty. See Note [NO TYVARS] below. - -approximateImplications :: SDoc -> (Inst -> Bool) -> [Inst] -> TcM ([Inst], TcDictBinds) --- Note [Inference and implication constraints] --- Given a bunch of Dict and ImplicInsts, try to approximate the implications by --- - fetching any dicts inside them that are free --- - using those dicts as cruder constraints, to solve the implications --- - returning the extra ones too - -approximateImplications doc want_dict irreds - | null extra_dicts - = return (irreds, emptyBag) - | otherwise - = do { extra_dicts' <- mapM cloneDict extra_dicts - ; tryHardCheckLoop doc (extra_dicts' ++ irreds) } - -- By adding extra_dicts', we make them - -- available to solve the implication constraints - where - extra_dicts = get_dicts (filter isImplicInst irreds) - - get_dicts :: [Inst] -> [Inst] -- Returns only Dicts - -- Find the wanted constraints in implication constraints that satisfy - -- want_dict, and are not bound by forall's in the constraint itself - get_dicts ds = concatMap get_dict ds - - get_dict d@(Dict {}) | want_dict d = [d] - | otherwise = [] - get_dict (ImplicInst {tci_tyvars = tvs, tci_wanted = wanteds}) - = [ d | let tv_set = mkVarSet tvs - , d <- get_dicts wanteds - , not (tyVarsOfInst d `intersectsVarSet` tv_set)] - get_dict i@(EqInst {}) | want_dict i = [i] - | otherwise = [] - get_dict other = pprPanic "approximateImplications" (ppr other) -\end{code} - -Note [Inference and implication constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we have a wanted implication constraint (perhaps arising from -a nested pattern match) like - C a => D [a] -and we are now trying to quantify over 'a' when inferring the type for -a function. In principle it's possible that there might be an instance - instance (C a, E a) => D [a] -so the context (E a) would suffice. The Right Thing is to abstract over -the implication constraint, but we don't do that (a) because it'll be -surprising to programmers and (b) because we don't have the machinery to deal -with 'given' implications. - -So our best approximation is to make (D [a]) part of the inferred -context, so we can use that to discharge the implication. Hence -the strange function get_dicts in approximateImplications. - -The common cases are more clear-cut, when we have things like - forall a. C a => C b -Here, abstracting over (C b) is not an approximation at all -- but see -Note [Freeness and implications]. - -See Trac #1430 and test tc228. - - -\begin{code} ------------------------------------------------------------ --- tcSimplifyInferCheck is used when we know the constraints we are to simplify --- against, but we don't know the type variables over which we are going to quantify. --- This happens when we have a type signature for a mutually recursive group -tcSimplifyInferCheck - :: InstLoc - -> TcTyVarSet -- fv(T) - -> [Inst] -- Given - -> [Inst] -- Wanted - -> TcM ([TyVar], -- Fully zonked, and quantified - TcDictBinds) -- Bindings - -tcSimplifyInferCheck loc tau_tvs givens wanteds - = do { traceTc (text "tcSimplifyInferCheck <-" <+> ppr wanteds) - ; (irreds, binds) <- gentleCheckLoop loc givens wanteds - - -- Figure out which type variables to quantify over - -- You might think it should just be the signature tyvars, - -- but in bizarre cases you can get extra ones - -- f :: forall a. Num a => a -> a - -- f x = fst (g (x, head [])) + 1 - -- g a b = (b,a) - -- Here we infer g :: forall a b. a -> b -> (b,a) - -- We don't want g to be monomorphic in b just because - -- f isn't quantified over b. - ; let all_tvs = varSetElems (tau_tvs `unionVarSet` tyVarsOfInsts givens) - ; all_tvs <- zonkTcTyVarsAndFV all_tvs - ; gbl_tvs <- tcGetGlobalTyVars - ; let qtvs = varSetElems (all_tvs `minusVarSet` gbl_tvs) - -- We could close gbl_tvs, but its not necessary for - -- soundness, and it'll only affect which tyvars, not which - -- dictionaries, we quantify over - - ; qtvs' <- zonkQuantifiedTyVars qtvs - - -- Now we are back to normal (c.f. tcSimplCheck) - ; implic_bind <- bindIrreds loc qtvs' givens irreds - - ; traceTc (text "tcSimplifyInferCheck ->" <+> ppr (implic_bind)) - ; return (qtvs', binds `unionBags` implic_bind) } -\end{code} - -Note [Squashing methods] -~~~~~~~~~~~~~~~~~~~~~~~~~ -Be careful if you want to float methods more: - truncate :: forall a. RealFrac a => forall b. Integral b => a -> b -From an application (truncate f i) we get - t1 = truncate at f - t2 = t1 at i -If we have also have a second occurrence of truncate, we get - t3 = truncate at f - t4 = t3 at i -When simplifying with i,f free, we might still notice that -t1=t3; but alas, the binding for t2 (which mentions t1) -may continue to float out! - - -Note [NO TYVARS] -~~~~~~~~~~~~~~~~~ - class Y a b | a -> b where - y :: a -> X b - - instance Y [[a]] a where - y ((x:_):_) = X x - - k :: X a -> X a -> X a - - g :: Num a => [X a] -> [X a] - g xs = h xs - where - h ys = ys ++ map (k (y [[0]])) xs - -The excitement comes when simplifying the bindings for h. Initially -try to simplify {y @ [[t1]] t2, 0 @ t1}, with initial qtvs = {t2}. -From this we get t1~t2, but also various bindings. We can't forget -the bindings (because of [LOOP]), but in fact t1 is what g is -polymorphic in. - -The net effect of [NO TYVARS] - -\begin{code} -\end{code} - - -%************************************************************************ -%* * -\subsection{tcSimplifyCheck} -%* * -%************************************************************************ - -@tcSimplifyCheck@ is used when we know exactly the set of variables -we are going to quantify over. For example, a class or instance declaration. - -\begin{code} ------------------------------------------------------------ --- tcSimplifyCheck is used when checking expression type signatures, --- class decls, instance decls etc. -tcSimplifyCheck :: InstLoc - -> [TcTyVar] -- Quantify over these - -> [Inst] -- Given - -> [Inst] -- Wanted - -> TcM TcDictBinds -- Bindings -tcSimplifyCheck loc qtvs givens wanteds - = ASSERT( all isTcTyVar qtvs && all isSkolemTyVar qtvs ) - do { traceTc (text "tcSimplifyCheck") - ; (irreds, binds) <- gentleCheckLoop loc givens wanteds - ; implic_bind <- bindIrreds loc qtvs givens irreds - ; return (binds `unionBags` implic_bind) } - ------------------------------------------------------------ --- tcSimplifyCheckPat is used for existential pattern match -tcSimplifyCheckPat :: InstLoc - -> [TcTyVar] -- Quantify over these - -> [Inst] -- Given - -> [Inst] -- Wanted - -> TcM TcDictBinds -- Bindings -tcSimplifyCheckPat loc qtvs givens wanteds - = ASSERT( all isTcTyVar qtvs && all isSkolemTyVar qtvs ) - do { traceTc (text "tcSimplifyCheckPat") - ; (irreds, binds) <- gentleCheckLoop loc givens wanteds - ; implic_bind <- bindIrredsR loc qtvs givens irreds - ; return (binds `unionBags` implic_bind) } - ------------------------------------------------------------ -bindIrreds :: InstLoc -> [TcTyVar] - -> [Inst] -> [Inst] - -> TcM TcDictBinds -bindIrreds loc qtvs givens irreds - = bindIrredsR loc qtvs givens irreds - -bindIrredsR :: InstLoc -> [TcTyVar] -> [Inst] -> [Inst] -> TcM TcDictBinds --- Make a binding that binds 'irreds', by generating an implication --- constraint for them, *and* throwing the constraint into the LIE -bindIrredsR loc qtvs givens irreds - | null irreds - = return emptyBag - | otherwise - = do { let givens' = filter isAbstractableInst givens - -- The givens can (redundantly) include methods - -- We want to retain both EqInsts and Dicts - -- There should be no implicadtion constraints - -- See Note [Pruning the givens in an implication constraint] - - -- If there are no 'givens', then it's safe to - -- partition the 'wanteds' by their qtvs, thereby trimming irreds - -- See Note [Freeness and implications] - ; irreds' <- if null givens' - then do - { let qtv_set = mkVarSet qtvs - (frees, real_irreds) = partition (isFreeWrtTyVars qtv_set) irreds - ; extendLIEs frees - ; return real_irreds } - else return irreds - - ; (implics, bind) <- makeImplicationBind loc qtvs givens' irreds' - -- This call does the real work - -- If irreds' is empty, it does something sensible - ; extendLIEs implics - ; return bind } - - -makeImplicationBind :: InstLoc -> [TcTyVar] - -> [Inst] -> [Inst] - -> TcM ([Inst], TcDictBinds) --- Make a binding that binds 'irreds', by generating an implication --- constraint for them. --- --- The binding looks like --- (ir1, .., irn) = f qtvs givens --- where f is (evidence for) the new implication constraint --- f :: forall qtvs. givens => (ir1, .., irn) --- qtvs includes coercion variables --- --- This binding must line up the 'rhs' in reduceImplication -makeImplicationBind loc all_tvs - givens -- Guaranteed all Dicts or EqInsts - irreds - | null irreds -- If there are no irreds, we are done - = return ([], emptyBag) - | otherwise -- Otherwise we must generate a binding - = do { uniq <- newUnique - ; span <- getSrcSpanM - ; let (eq_givens, dict_givens) = partition isEqInst givens - - -- extract equality binders - eq_cotvs = map eqInstType eq_givens - - -- make the implication constraint instance - name = mkInternalName uniq (mkVarOcc "ic") span - implic_inst = ImplicInst { tci_name = name, - tci_tyvars = all_tvs, - tci_given = eq_givens ++ dict_givens, - -- same order as binders - tci_wanted = irreds, - tci_loc = loc } - - -- create binders for the irreducible dictionaries - dict_irreds = filter (not . isEqInst) irreds - dict_irred_ids = map instToId dict_irreds - lpat = mkBigLHsPatTup (map (L span . VarPat) dict_irred_ids) - - -- create the binding - rhs = L span (mkHsWrap co (HsVar (instToId implic_inst))) - co = mkWpApps (map instToId dict_givens) - <.> mkWpTyApps eq_cotvs - <.> mkWpTyApps (mkTyVarTys all_tvs) - bind | [dict_irred_id] <- dict_irred_ids - = mkVarBind dict_irred_id rhs - | otherwise - = L span $ - PatBind { pat_lhs = lpat - , pat_rhs = unguardedGRHSs rhs - , pat_rhs_ty = hsLPatType lpat - , bind_fvs = placeHolderNames - } - - ; traceTc $ text "makeImplicationBind" <+> ppr implic_inst - ; return ([implic_inst], unitBag bind) - } - ------------------------------------------------------------ -tryHardCheckLoop :: SDoc - -> [Inst] -- Wanted - -> TcM ([Inst], TcDictBinds) - -tryHardCheckLoop doc wanteds - = do { (irreds,binds) <- checkLoop (mkInferRedEnv doc try_me) wanteds - ; return (irreds,binds) - } - where - try_me _ = ReduceMe - -- Here's the try-hard bit - ------------------------------------------------------------ -gentleCheckLoop :: InstLoc - -> [Inst] -- Given - -> [Inst] -- Wanted - -> TcM ([Inst], TcDictBinds) - -gentleCheckLoop inst_loc givens wanteds - = do { (irreds,binds) <- checkLoop env wanteds - ; return (irreds,binds) - } - where - env = mkRedEnv (pprInstLoc inst_loc) try_me givens - - try_me inst | isMethodOrLit inst = ReduceMe - | otherwise = Stop - -- When checking against a given signature - -- we MUST be very gentle: Note [Check gently] - -gentleInferLoop :: SDoc -> [Inst] - -> TcM ([Inst], TcDictBinds) -gentleInferLoop doc wanteds - = do { (irreds, binds) <- checkLoop env wanteds - ; return (irreds, binds) } - where - env = mkInferRedEnv doc try_me - try_me inst | isMethodOrLit inst = ReduceMe - | otherwise = Stop -\end{code} - -Note [Check gently] -~~~~~~~~~~~~~~~~~~~~ -We have to very careful about not simplifying too vigorously -Example: - data T a where - MkT :: a -> T [a] - - f :: Show b => T b -> b - f (MkT x) = show [x] - -Inside the pattern match, which binds (a:*, x:a), we know that - b ~ [a] -Hence we have a dictionary for Show [a] available; and indeed we -need it. We are going to build an implication contraint - forall a. (b~[a]) => Show [a] -Later, we will solve this constraint using the knowledge (Show b) - -But we MUST NOT reduce (Show [a]) to (Show a), else the whole -thing becomes insoluble. So we simplify gently (get rid of literals -and methods only, plus common up equal things), deferring the real -work until top level, when we solve the implication constraint -with tryHardCheckLooop. - - -\begin{code} ------------------------------------------------------------ -checkLoop :: RedEnv - -> [Inst] -- Wanted - -> TcM ([Inst], TcDictBinds) --- Precondition: givens are completely rigid --- Postcondition: returned Insts are zonked - -checkLoop env wanteds - = go env wanteds - where go env wanteds - = do { -- We do need to zonk the givens; cf Note [Zonking RedEnv] - ; env' <- zonkRedEnv env - ; wanteds' <- zonkInsts wanteds - - ; (improved, tybinds, binds, irreds) - <- reduceContext env' wanteds' - ; execTcTyVarBinds tybinds - - ; if null irreds || not improved then - return (irreds, binds) - else do - - -- If improvement did some unification, we go round again. - -- We start again with irreds, not wanteds - -- Using an instance decl might have introduced a fresh type - -- variable which might have been unified, so we'd get an - -- infinite loop if we started again with wanteds! - -- See Note [LOOP] - { (irreds1, binds1) <- go env' irreds - ; return (irreds1, binds `unionBags` binds1) } } -\end{code} - -Note [Zonking RedEnv] -~~~~~~~~~~~~~~~~~~~~~ -It might appear as if the givens in RedEnv are always rigid, but that is not -necessarily the case for programs involving higher-rank types that have class -contexts constraining the higher-rank variables. An example from tc237 in the -testsuite is - - class Modular s a | s -> a - - wim :: forall a w. Integral a - => a -> (forall s. Modular s a => M s w) -> w - wim i k = error "urk" - - test5 :: (Modular s a, Integral a) => M s a - test5 = error "urk" - - test4 = wim 4 test4' - -Notice how the variable 'a' of (Modular s a) in the rank-2 type of wim is -quantified further outside. When type checking test4, we have to check -whether the signature of test5 is an instance of - - (forall s. Modular s a => M s w) - -Consequently, we will get (Modular s t_a), where t_a is a TauTv into the -givens. - -Given the FD of Modular in this example, class improvement will instantiate -t_a to 'a', where 'a' is the skolem from test5's signatures (due to the -Modular s a predicate in that signature). If we don't zonk (Modular s t_a) in -the givens, we will get into a loop as improveOne uses the unification engine -Unify.tcUnifyTys, which doesn't know about mutable type variables. - - -Note [LOOP] -~~~~~~~~~~~ - class If b t e r | b t e -> r - instance If T t e t - instance If F t e e - class Lte a b c | a b -> c where lte :: a -> b -> c - instance Lte Z b T - instance (Lte a b l,If l b a c) => Max a b c - -Wanted: Max Z (S x) y - -Then we'll reduce using the Max instance to: - (Lte Z (S x) l, If l (S x) Z y) -and improve by binding l->T, after which we can do some reduction -on both the Lte and If constraints. What we *can't* do is start again -with (Max Z (S x) y)! - - - -%************************************************************************ -%* * - tcSimplifySuperClasses -%* * -%************************************************************************ - -Note [SUPERCLASS-LOOP 1] -~~~~~~~~~~~~~~~~~~~~~~~~ -We have to be very, very careful when generating superclasses, lest we -accidentally build a loop. Here's an example: - - class S a - - class S a => C a where { opc :: a -> a } - class S b => D b where { opd :: b -> b } - - instance C Int where - opc = opd - - instance D Int where - opd = opc - -From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int} -Simplifying, we may well get: - $dfCInt = :C ds1 (opd dd) - dd = $dfDInt - ds1 = $p1 dd -Notice that we spot that we can extract ds1 from dd. - -Alas! Alack! We can do the same for (instance D Int): - - $dfDInt = :D ds2 (opc dc) - dc = $dfCInt - ds2 = $p1 dc - -And now we've defined the superclass in terms of itself. -Two more nasty cases are in - tcrun021 - tcrun033 - -Solution: - - Satisfy the superclass context *all by itself* - (tcSimplifySuperClasses) - - And do so completely; i.e. no left-over constraints - to mix with the constraints arising from method declarations - - -Note [Recursive instances and superclases] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider this code, which arises in the context of "Scrap Your -Boilerplate with Class". - - class Sat a - class Data ctx a - instance Sat (ctx Char) => Data ctx Char - instance (Sat (ctx [a]), Data ctx a) => Data ctx [a] - - class Data Maybe a => Foo a - - instance Foo t => Sat (Maybe t) - - instance Data Maybe a => Foo a - instance Foo a => Foo [a] - instance Foo [Char] - -In the instance for Foo [a], when generating evidence for the superclasses -(ie in tcSimplifySuperClasses) we need a superclass (Data Maybe [a]). -Using the instance for Data, we therefore need - (Sat (Maybe [a], Data Maybe a) -But we are given (Foo a), and hence its superclass (Data Maybe a). -So that leaves (Sat (Maybe [a])). Using the instance for Sat means -we need (Foo [a]). And that is the very dictionary we are bulding -an instance for! So we must put that in the "givens". So in this -case we have - Given: Foo a, Foo [a] - Watend: Data Maybe [a] - -BUT we must *not not not* put the *superclasses* of (Foo [a]) in -the givens, which is what 'addGiven' would normally do. Why? Because -(Data Maybe [a]) is the superclass, so we'd "satisfy" the wanted -by selecting a superclass from Foo [a], which simply makes a loop. - -On the other hand we *must* put the superclasses of (Foo a) in -the givens, as you can see from the derivation described above. - -Conclusion: in the very special case of tcSimplifySuperClasses -we have one 'given' (namely the "this" dictionary) whose superclasses -must not be added to 'givens' by addGiven. - -There is a complication though. Suppose there are equalities - instance (Eq a, a~b) => Num (a,b) -Then we normalise the 'givens' wrt the equalities, so the original -given "this" dictionary is cast to one of a different type. So it's a -bit trickier than before to identify the "special" dictionary whose -superclasses must not be added. See test - indexed-types/should_run/EqInInstance - -We need a persistent property of the dictionary to record this -special-ness. Current I'm using the InstLocOrigin (a bit of a hack, -but cool), which is maintained by dictionary normalisation. -Specifically, the InstLocOrigin is - NoScOrigin -then the no-superclass thing kicks in. WATCH OUT if you fiddle -with InstLocOrigin! - -\begin{code} -tcSimplifySuperClasses - :: InstLoc - -> Inst -- The dict whose superclasses - -- are being figured out - -> [Inst] -- Given - -> [Inst] -- Wanted - -> TcM TcDictBinds -tcSimplifySuperClasses loc this givens sc_wanteds - = do { traceTc (text "tcSimplifySuperClasses") - - -- Note [Recursive instances and superclases] - ; no_sc_loc <- getInstLoc NoScOrigin - ; let no_sc_this = setInstLoc this no_sc_loc - - ; let env = RedEnv { red_doc = pprInstLoc loc, - red_try_me = try_me, - red_givens = no_sc_this : givens, - red_stack = (0,[]), - red_improve = False } -- No unification vars - - - ; (irreds,binds1) <- checkLoop env sc_wanteds - ; let (tidy_env, tidy_irreds) = tidyInsts irreds - ; reportNoInstances tidy_env (Just (loc, givens)) [] tidy_irreds - ; return binds1 } - where - try_me _ = ReduceMe -- Try hard, so we completely solve the superclass - -- constraints right here. See Note [SUPERCLASS-LOOP 1] -\end{code} - - -%************************************************************************ -%* * -\subsection{tcSimplifyRestricted} -%* * -%************************************************************************ - -tcSimplifyRestricted infers which type variables to quantify for a -group of restricted bindings. This isn't trivial. - -Eg1: id = \x -> x - We want to quantify over a to get id :: forall a. a->a - -Eg2: eq = (==) - We do not want to quantify over a, because there's an Eq a - constraint, so we get eq :: a->a->Bool (notice no forall) - -So, assume: - RHS has type 'tau', whose free tyvars are tau_tvs - RHS has constraints 'wanteds' - -Plan A (simple) - Quantify over (tau_tvs \ ftvs(wanteds)) - This is bad. The constraints may contain (Monad (ST s)) - where we have instance Monad (ST s) where... - so there's no need to be monomorphic in s! - - Also the constraint might be a method constraint, - whose type mentions a perfectly innocent tyvar: - op :: Num a => a -> b -> a - Here, b is unconstrained. A good example would be - foo = op (3::Int) - We want to infer the polymorphic type - foo :: forall b. b -> b - - -Plan B (cunning, used for a long time up to and including GHC 6.2) - Step 1: Simplify the constraints as much as possible (to deal - with Plan A's problem). Then set - qtvs = tau_tvs \ ftvs( simplify( wanteds ) ) - - Step 2: Now simplify again, treating the constraint as 'free' if - it does not mention qtvs, and trying to reduce it otherwise. - The reasons for this is to maximise sharing. - - This fails for a very subtle reason. Suppose that in the Step 2 - a constraint (Foo (Succ Zero) (Succ Zero) b) gets thrown upstairs as 'free'. - In the Step 1 this constraint might have been simplified, perhaps to - (Foo Zero Zero b), AND THEN THAT MIGHT BE IMPROVED, to bind 'b' to 'T'. - This won't happen in Step 2... but that in turn might prevent some other - constraint (Baz [a] b) being simplified (e.g. via instance Baz [a] T where {..}) - and that in turn breaks the invariant that no constraints are quantified over. - - Test typecheck/should_compile/tc177 (which failed in GHC 6.2) demonstrates - the problem. - - -Plan C (brutal) - Step 1: Simplify the constraints as much as possible (to deal - with Plan A's problem). Then set - qtvs = tau_tvs \ ftvs( simplify( wanteds ) ) - Return the bindings from Step 1. - - -A note about Plan C (arising from "bug" reported by George Russel March 2004) -Consider this: - - instance (HasBinary ty IO) => HasCodedValue ty - - foo :: HasCodedValue a => String -> IO a - - doDecodeIO :: HasCodedValue a => () -> () -> IO a - doDecodeIO codedValue view - = let { act = foo "foo" } in act - -You might think this should work becuase the call to foo gives rise to a constraint -(HasCodedValue t), which can be satisfied by the type sig for doDecodeIO. But the -restricted binding act = ... calls tcSimplifyRestricted, and PlanC simplifies the -constraint using the (rather bogus) instance declaration, and now we are stuffed. - -I claim this is not really a bug -- but it bit Sergey as well as George. So here's -plan D - - -Plan D (a variant of plan B) - Step 1: Simplify the constraints as much as possible (to deal - with Plan A's problem), BUT DO NO IMPROVEMENT. Then set - qtvs = tau_tvs \ ftvs( simplify( wanteds ) ) - - Step 2: Now simplify again, treating the constraint as 'free' if - it does not mention qtvs, and trying to reduce it otherwise. - - The point here is that it's generally OK to have too few qtvs; that is, - to make the thing more monomorphic than it could be. We don't want to - do that in the common cases, but in wierd cases it's ok: the programmer - can always add a signature. - - Too few qtvs => too many wanteds, which is what happens if you do less - improvement. - - -\begin{code} -tcSimplifyRestricted -- Used for restricted binding groups - -- i.e. ones subject to the monomorphism restriction - :: SDoc - -> TopLevelFlag - -> [Name] -- Things bound in this group - -> TcTyVarSet -- Free in the type of the RHSs - -> [Inst] -- Free in the RHSs - -> TcM ([TyVar], -- Tyvars to quantify (zonked and quantified) - TcDictBinds) -- Bindings - -- tcSimpifyRestricted returns no constraints to - -- quantify over; by definition there are none. - -- They are all thrown back in the LIE - -tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds - -- Zonk everything in sight - = do { traceTc (text "tcSimplifyRestricted") - ; wanteds_z <- zonkInsts wanteds - - -- 'ReduceMe': Reduce as far as we can. Don't stop at - -- dicts; the idea is to get rid of as many type - -- variables as possible, and we don't want to stop - -- at (say) Monad (ST s), because that reduces - -- immediately, with no constraint on s. - -- - -- BUT do no improvement! See Plan D above - -- HOWEVER, some unification may take place, if we instantiate - -- a method Inst with an equality constraint - ; let env = mkNoImproveRedEnv doc (\_ -> ReduceMe) - ; (_imp, _tybinds, _binds, constrained_dicts) - <- reduceContext env wanteds_z - - -- Next, figure out the tyvars we will quantify over - ; tau_tvs' <- zonkTcTyVarsAndFV (varSetElems tau_tvs) - ; gbl_tvs' <- tcGetGlobalTyVars - ; constrained_dicts' <- zonkInsts constrained_dicts - - ; let qtvs1 = tau_tvs' `minusVarSet` oclose (fdPredsOfInsts constrained_dicts) gbl_tvs' - -- As in tcSimplifyInfer - - -- Do not quantify over constrained type variables: - -- this is the monomorphism restriction - constrained_tvs' = tyVarsOfInsts constrained_dicts' - qtvs = qtvs1 `minusVarSet` constrained_tvs' - pp_bndrs = pprWithCommas (quotes . ppr) bndrs - - -- Warn in the mono - ; warn_mono <- doptM Opt_WarnMonomorphism - ; warnTc (warn_mono && (constrained_tvs' `intersectsVarSet` qtvs1)) - (vcat[ ptext (sLit "the Monomorphism Restriction applies to the binding") - <> plural bndrs <+> ptext (sLit "for") <+> pp_bndrs, - ptext (sLit "Consider giving a type signature for") <+> pp_bndrs]) - - ; traceTc (text "tcSimplifyRestricted" <+> vcat [ - pprInsts wanteds, pprInsts constrained_dicts', - ppr _binds, - ppr constrained_tvs', ppr tau_tvs', ppr qtvs ]) - - -- The first step may have squashed more methods than - -- necessary, so try again, this time more gently, knowing the exact - -- set of type variables to quantify over. - -- - -- We quantify only over constraints that are captured by qtvs; - -- these will just be a subset of non-dicts. This in contrast - -- to normal inference (using isFreeWhenInferring) in which we quantify over - -- all *non-inheritable* constraints too. This implements choice - -- (B) under "implicit parameter and monomorphism" above. - -- - -- Remember that we may need to do *some* simplification, to - -- (for example) squash {Monad (ST s)} into {}. It's not enough - -- just to float all constraints - -- - -- At top level, we *do* squash methods because we want to - -- expose implicit parameters to the test that follows - ; let is_nested_group = isNotTopLevel top_lvl - try_me inst | isFreeWrtTyVars qtvs inst, - (is_nested_group || isDict inst) = Stop - | otherwise = ReduceMe - env = mkNoImproveRedEnv doc try_me - ; (_imp, tybinds, binds, irreds) <- reduceContext env wanteds_z - ; execTcTyVarBinds tybinds - - -- See "Notes on implicit parameters, Question 4: top level" - ; ASSERT( all (isFreeWrtTyVars qtvs) irreds ) -- None should be captured - if is_nested_group then - extendLIEs irreds - else do { let (bad_ips, non_ips) = partition isIPDict irreds - ; addTopIPErrs bndrs bad_ips - ; extendLIEs non_ips } - - ; qtvs' <- zonkQuantifiedTyVars (varSetElems qtvs) - ; return (qtvs', binds) } -\end{code} - - -%************************************************************************ -%* * - tcSimplifyRuleLhs -%* * -%************************************************************************ - -On the LHS of transformation rules we only simplify methods and constants, -getting dictionaries. We want to keep all of them unsimplified, to serve -as the available stuff for the RHS of the rule. - -Example. Consider the following left-hand side of a rule - - f (x == y) (y > z) = ... - -If we typecheck this expression we get constraints - - d1 :: Ord a, d2 :: Eq a - -We do NOT want to "simplify" to the LHS - - forall x::a, y::a, z::a, d1::Ord a. - f ((==) (eqFromOrd d1) x y) ((>) d1 y z) = ... - -Instead we want - - forall x::a, y::a, z::a, d1::Ord a, d2::Eq a. - f ((==) d2 x y) ((>) d1 y z) = ... - -Here is another example: - - fromIntegral :: (Integral a, Num b) => a -> b - {-# RULES "foo" fromIntegral = id :: Int -> Int #-} - -In the rule, a=b=Int, and Num Int is a superclass of Integral Int. But -we *dont* want to get - - forall dIntegralInt. - fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int - -because the scsel will mess up RULE matching. Instead we want - - forall dIntegralInt, dNumInt. - fromIntegral Int Int dIntegralInt dNumInt = id Int - -Even if we have - - g (x == y) (y == z) = .. - -where the two dictionaries are *identical*, we do NOT WANT - - forall x::a, y::a, z::a, d1::Eq a - f ((==) d1 x y) ((>) d1 y z) = ... - -because that will only match if the dict args are (visibly) equal. -Instead we want to quantify over the dictionaries separately. - -In short, tcSimplifyRuleLhs must *only* squash LitInst and MethInts, leaving -all dicts unchanged, with absolutely no sharing. It's simpler to do this -from scratch, rather than further parameterise simpleReduceLoop etc. -Simpler, maybe, but alas not simple (see Trac #2494) - -* Type errors may give rise to an (unsatisfiable) equality constraint - -* Applications of a higher-rank function on the LHS may give - rise to an implication constraint, esp if there are unsatisfiable - equality constraints inside. - -\begin{code} -tcSimplifyRuleLhs :: [Inst] -> TcM ([Inst], TcDictBinds) -tcSimplifyRuleLhs wanteds - = do { wanteds' <- zonkInsts wanteds - - -- Simplify equalities - -- It's important to do this: Trac #3346 for example - ; (_, wanteds'', tybinds, binds1) <- tcReduceEqs [] wanteds' - ; execTcTyVarBinds tybinds - - -- Simplify other constraints - ; (irreds, binds2) <- go [] emptyBag wanteds'' - - -- Report anything that is left - ; let (dicts, bad_irreds) = partition isDict irreds - ; traceTc (text "tcSimplifyrulelhs" <+> pprInsts bad_irreds) - ; addNoInstanceErrs (nub bad_irreds) - -- The nub removes duplicates, which has - -- not happened otherwise (see notes above) - - ; return (dicts, binds1 `unionBags` binds2) } - where - go :: [Inst] -> TcDictBinds -> [Inst] -> TcM ([Inst], TcDictBinds) - go irreds binds [] - = return (irreds, binds) - go irreds binds (w:ws) - | isDict w - = go (w:irreds) binds ws - | isImplicInst w -- Have a go at reducing the implication - = do { (binds1, irreds1) <- reduceImplication red_env w - ; let (bad_irreds, ok_irreds) = partition isImplicInst irreds1 - ; go (bad_irreds ++ irreds) - (binds `unionBags` binds1) - (ok_irreds ++ ws)} - | otherwise - = do { w' <- zonkInst w -- So that (3::Int) does not generate a call - -- to fromInteger; this looks fragile to me - ; lookup_result <- lookupSimpleInst w' - ; case lookup_result of - NoInstance -> go (w:irreds) binds ws - GenInst ws' rhs -> go irreds binds' (ws' ++ ws) - where - binds' = addInstToDictBind binds w rhs - } - - -- Sigh: we need to reduce inside implications - red_env = mkInferRedEnv doc try_me - doc = ptext (sLit "Implication constraint in RULE lhs") - try_me inst | isMethodOrLit inst = ReduceMe - | otherwise = Stop -- Be gentle -\end{code} - -tcSimplifyBracket is used when simplifying the constraints arising from -a Template Haskell bracket [| ... |]. We want to check that there aren't -any constraints that can't be satisfied (e.g. Show Foo, where Foo has no -Show instance), but we aren't otherwise interested in the results. -Nor do we care about ambiguous dictionaries etc. We will type check -this bracket again at its usage site. - -\begin{code} -tcSimplifyBracket :: [Inst] -> TcM () -tcSimplifyBracket wanteds - = do { _ <- tryHardCheckLoop doc wanteds - ; return () } - where - doc = text "tcSimplifyBracket" -\end{code} - - -%************************************************************************ -%* * -\subsection{Filtering at a dynamic binding} -%* * -%************************************************************************ - -When we have - let ?x = R in B - -we must discharge all the ?x constraints from B. We also do an improvement -step; if we have ?x::t1 and ?x::t2 we must unify t1, t2. - -Actually, the constraints from B might improve the types in ?x. For example - - f :: (?x::Int) => Char -> Char - let ?x = 3 in f 'c' - -then the constraint (?x::Int) arising from the call to f will -force the binding for ?x to be of type Int. - -\begin{code} -tcSimplifyIPs :: [Inst] -- The implicit parameters bound here - -> [Inst] -- Wanted - -> TcM TcDictBinds - -- We need a loop so that we do improvement, and then - -- (next time round) generate a binding to connect the two - -- let ?x = e in ?x - -- Here the two ?x's have different types, and improvement - -- makes them the same. - -tcSimplifyIPs given_ips wanteds - = do { wanteds' <- zonkInsts wanteds - ; given_ips' <- zonkInsts given_ips - -- Unusually for checking, we *must* zonk the given_ips - - ; let env = mkRedEnv doc try_me given_ips' - ; (improved, tybinds, binds, irreds) <- reduceContext env wanteds' - ; execTcTyVarBinds tybinds - - ; if null irreds || not improved then - ASSERT( all is_free irreds ) - do { extendLIEs irreds - ; return binds } - else do - -- If improvement did some unification, we go round again. - -- We start again with irreds, not wanteds - -- Using an instance decl might have introduced a fresh type - -- variable which might have been unified, so we'd get an - -- infinite loop if we started again with wanteds! - -- See Note [LOOP] - { binds1 <- tcSimplifyIPs given_ips' irreds - ; return $ binds `unionBags` binds1 - } } - where - doc = text "tcSimplifyIPs" <+> ppr given_ips - ip_set = mkNameSet (ipNamesOfInsts given_ips) - is_free inst = isFreeWrtIPs ip_set inst - - -- Simplify any methods that mention the implicit parameter - try_me inst | is_free inst = Stop - | otherwise = ReduceMe -\end{code} - - -%************************************************************************ -%* * -\subsection[binds-for-local-funs]{@bindInstsOfLocalFuns@} -%* * -%************************************************************************ - -When doing a binding group, we may have @Insts@ of local functions. -For example, we might have... -\begin{verbatim} -let f x = x + 1 -- orig local function (overloaded) - f.1 = f Int -- two instances of f - f.2 = f Float - in - (f.1 5, f.2 6.7) -\end{verbatim} -The point is: we must drop the bindings for @f.1@ and @f.2@ here, -where @f@ is in scope; those @Insts@ must certainly not be passed -upwards towards the top-level. If the @Insts@ were binding-ified up -there, they would have unresolvable references to @f@. - -We pass in an @init_lie@ of @Insts@ and a list of locally-bound @Ids@. -For each method @Inst@ in the @init_lie@ that mentions one of the -@Ids@, we create a binding. We return the remaining @Insts@ (in an -@LIE@), as well as the @HsBinds@ generated. - -\begin{code} -bindInstsOfLocalFuns :: [Inst] -> [TcId] -> TcM TcDictBinds --- Simlifies only MethodInsts, and generate only bindings of form --- fm = f tys dicts --- We're careful not to even generate bindings of the form --- d1 = d2 --- You'd think that'd be fine, but it interacts with what is --- arguably a bug in Match.tidyEqnInfo (see notes there) - -bindInstsOfLocalFuns wanteds local_ids - | null overloaded_ids = do - -- Common case - extendLIEs wanteds - return emptyLHsBinds - - | otherwise - = do { (irreds, binds) <- gentleInferLoop doc for_me - ; extendLIEs not_for_me - ; extendLIEs irreds - ; return binds } - where - doc = text "bindInsts" <+> ppr local_ids - overloaded_ids = filter is_overloaded local_ids - is_overloaded id = isOverloadedTy (idType id) - (for_me, not_for_me) = partition (isMethodFor overloaded_set) wanteds - - overloaded_set = mkVarSet overloaded_ids -- There can occasionally be a lot of them - -- so it's worth building a set, so that - -- lookup (in isMethodFor) is faster -\end{code} - - -%************************************************************************ -%* * -\subsection{Data types for the reduction mechanism} -%* * -%************************************************************************ - -The main control over context reduction is here - -\begin{code} -data RedEnv - = RedEnv { red_doc :: SDoc -- The context - , red_try_me :: Inst -> WhatToDo - , red_improve :: Bool -- True <=> do improvement - , red_givens :: [Inst] -- All guaranteed rigid - -- Always dicts & equalities - -- but see Note [Rigidity] - - , red_stack :: (Int, [Inst]) -- Recursion stack (for err msg) - -- See Note [RedStack] - } - --- Note [Rigidity] --- The red_givens are rigid so far as cmpInst is concerned. --- There is one case where they are not totally rigid, namely in tcSimplifyIPs --- let ?x = e in ... --- Here, the given is (?x::a), where 'a' is not necy a rigid type --- But that doesn't affect the comparison, which is based only on mame. - --- Note [RedStack] --- The red_stack pair (n,insts) pair is just used for error reporting. --- 'n' is always the depth of the stack. --- The 'insts' is the stack of Insts being reduced: to produce X --- I had to produce Y, to produce Y I had to produce Z, and so on. - - -mkRedEnv :: SDoc -> (Inst -> WhatToDo) -> [Inst] -> RedEnv -mkRedEnv doc try_me givens - = RedEnv { red_doc = doc, red_try_me = try_me, - red_givens = givens, - red_stack = (0,[]), - red_improve = True } - -mkInferRedEnv :: SDoc -> (Inst -> WhatToDo) -> RedEnv --- No givens at all -mkInferRedEnv doc try_me - = RedEnv { red_doc = doc, red_try_me = try_me, - red_givens = [], - red_stack = (0,[]), - red_improve = True } - -mkNoImproveRedEnv :: SDoc -> (Inst -> WhatToDo) -> RedEnv --- Do not do improvement; no givens -mkNoImproveRedEnv doc try_me - = RedEnv { red_doc = doc, red_try_me = try_me, - red_givens = [], - red_stack = (0,[]), - red_improve = True } - -data WhatToDo - = ReduceMe -- Try to reduce this - -- If there's no instance, add the inst to the - -- irreductible ones, but don't produce an error - -- message of any kind. - -- It might be quite legitimate such as (Eq a)! - - | Stop -- Return as irreducible unless it can - -- be reduced to a constant in one step - -- Do not add superclasses; see - -data WantSCs = NoSCs | AddSCs -- Tells whether we should add the superclasses - -- of a predicate when adding it to the avails - -- The reason for this flag is entirely the super-class loop problem - -- Note [SUPER-CLASS LOOP 1] - -zonkRedEnv :: RedEnv -> TcM RedEnv -zonkRedEnv env - = do { givens' <- mapM zonkInst (red_givens env) - ; return $ env {red_givens = givens'} - } -\end{code} - - -%************************************************************************ -%* * -\subsection[reduce]{@reduce@} -%* * -%************************************************************************ - -Note [Ancestor Equalities] -~~~~~~~~~~~~~~~~~~~~~~~~~~ -During context reduction, we add to the wanted equalities also those -equalities that (transitively) occur in superclass contexts of wanted -class constraints. Consider the following code - - class a ~ Int => C a - instance C Int - -If (C a) is wanted, we want to add (a ~ Int), which will be discharged by -substituting Int for a. Hence, we ultimately want (C Int), which we -discharge with the explicit instance. - -\begin{code} -reduceContext :: RedEnv - -> [Inst] -- Wanted - -> TcM (ImprovementDone, - TcTyVarBinds, -- Type variable bindings - TcDictBinds, -- Dictionary bindings - [Inst]) -- Irreducible - -reduceContext env wanteds0 - = do { traceTc (text "reduceContext" <+> (vcat [ - text "----------------------", - red_doc env, - text "given" <+> ppr (red_givens env), - text "wanted" <+> ppr wanteds0, - text "----------------------" - ])) - - -- We want to add as wanted equalities those that (transitively) - -- occur in superclass contexts of wanted class constraints. - -- See Note [Ancestor Equalities] - ; ancestor_eqs <- ancestorEqualities wanteds0 - ; traceTc $ text "reduceContext: ancestor eqs" <+> ppr ancestor_eqs - - -- Normalise and solve all equality constraints as far as possible - -- and normalise all dictionary constraints wrt to the reduced - -- equalities. The returned wanted constraints include the - -- irreducible wanted equalities. - ; let wanteds = wanteds0 ++ ancestor_eqs - givens = red_givens env - ; (givens', - wanteds', - tybinds, - normalise_binds) <- tcReduceEqs givens wanteds - ; traceTc $ text "reduceContext: tcReduceEqs result" <+> vcat - [ppr givens', ppr wanteds', ppr tybinds, - ppr normalise_binds] - - -- Build the Avail mapping from "given_dicts" - ; (init_state, _) <- getConstraints $ do - { init_state <- foldlM addGiven emptyAvails givens' - ; return init_state - } - - -- Solve the *wanted* *dictionary* constraints (not implications) - -- This may expose some further equational constraints in the course - -- of improvement due to functional dependencies if any of the - -- involved unifications gets deferred. - ; let (wanted_implics, wanted_dicts) = partition isImplicInst wanteds' - ; (avails, extra_eqs) <- getConstraints (reduceList env wanted_dicts init_state) - -- The getConstraints is reqd because reduceList does improvement - -- (via extendAvails) which may in turn do unification - ; (dict_binds, - bound_dicts, - dict_irreds) <- extractResults avails wanted_dicts - ; traceTc $ text "reduceContext: extractResults" <+> vcat - [ppr avails, ppr wanted_dicts, ppr dict_binds] - - -- Solve the wanted *implications*. In doing so, we can provide - -- as "given" all the dicts that were originally given, - -- *or* for which we now have bindings, - -- *or* which are now irreds - -- NB: Equality irreds need to be converted, as the recursive - -- invocation of the solver will still treat them as wanteds - -- otherwise. - ; let implic_env = env { red_givens - = givens ++ bound_dicts ++ - map wantedToLocalEqInst dict_irreds } - ; (implic_binds_s, implic_irreds_s) - <- mapAndUnzipM (reduceImplication implic_env) wanted_implics - ; let implic_binds = unionManyBags implic_binds_s - implic_irreds = concat implic_irreds_s - - -- Collect all irreducible instances, and determine whether we should - -- go round again. We do so in either of two cases: - -- (1) If dictionary reduction or equality solving led to - -- improvement (i.e., bindings for type variables). - -- (2) If we reduced dictionaries (i.e., got dictionary bindings), - -- they may have exposed further opportunities to normalise - -- family applications. See Note [Dictionary Improvement] - -- - -- NB: We do *not* go around for new extra_eqs. Morally, we should, - -- but we can't without risking non-termination (see #2688). By - -- not going around, we miss some legal programs mixing FDs and - -- TFs, but we never claimed to support such programs in the - -- current implementation anyway. - - ; let all_irreds = dict_irreds ++ implic_irreds ++ extra_eqs - avails_improved = availsImproved avails - eq_improved = anyBag (not . isCoVarBind) tybinds - improvedFlexible = avails_improved || eq_improved - reduced_dicts = not (isEmptyBag dict_binds) - improved = improvedFlexible || reduced_dicts - -- - improvedHint = (if avails_improved then " [AVAILS]" else "") ++ - (if eq_improved then " [EQ]" else "") - - ; traceTc (text "reduceContext end" <+> (vcat [ - text "----------------------", - red_doc env, - text "given" <+> ppr givens, - text "wanted" <+> ppr wanteds0, - text "----", - text "tybinds" <+> ppr tybinds, - text "avails" <+> pprAvails avails, - text "improved =" <+> ppr improved <+> text improvedHint, - text "(all) irreds = " <+> ppr all_irreds, - text "dict-binds = " <+> ppr dict_binds, - text "implic-binds = " <+> ppr implic_binds, - text "----------------------" - ])) - - ; return (improved, - tybinds, - normalise_binds `unionBags` dict_binds - `unionBags` implic_binds, - all_irreds) - } - where - isCoVarBind (TcTyVarBind tv _) = isCoVar tv - -tcImproveOne :: Avails -> Inst -> TcM ImprovementDone -tcImproveOne avails inst - | not (isDict inst) = return False - | otherwise - = do { inst_envs <- tcGetInstEnvs - ; let eqns = improveOne (classInstances inst_envs) - (dictPred inst, pprInstArising inst) - [ (dictPred p, pprInstArising p) - | p <- availsInsts avails, isDict p ] - -- Avails has all the superclasses etc (good) - -- It also has all the intermediates of the deduction (good) - -- It does not have duplicates (good) - -- NB that (?x::t1) and (?x::t2) will be held separately in - -- avails so that improve will see them separate - ; traceTc (text "improveOne" <+> ppr inst) - ; unifyEqns eqns } - -unifyEqns :: [(Equation, (PredType, SDoc), (PredType, SDoc))] - -> TcM ImprovementDone -unifyEqns [] = return False -unifyEqns eqns - = do { traceTc (ptext (sLit "Improve:") <+> vcat (map pprEquationDoc eqns)) - ; improved <- mapM unify eqns - ; return $ or improved - } - where - unify ((qtvs, pairs), what1, what2) - = addErrCtxtM (mkEqnMsg what1 what2) $ - do { let freeTyVars = unionVarSets (map tvs_pr pairs) - `minusVarSet` qtvs - ; (_, _, tenv) <- tcInstTyVars (varSetElems qtvs) - ; mapM_ (unif_pr tenv) pairs - ; anyM isFilledMetaTyVar $ varSetElems freeTyVars - } - - unif_pr tenv (ty1, ty2) = unifyType (substTy tenv ty1) (substTy tenv ty2) - - tvs_pr (ty1, ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2 - -pprEquationDoc :: (Equation, (PredType, SDoc), (PredType, SDoc)) -> SDoc -pprEquationDoc (eqn, (p1, _), (p2, _)) - = vcat [pprEquation eqn, nest 2 (ppr p1), nest 2 (ppr p2)] - -mkEqnMsg :: (TcPredType, SDoc) -> (TcPredType, SDoc) -> TidyEnv - -> TcM (TidyEnv, SDoc) -mkEqnMsg (pred1,from1) (pred2,from2) tidy_env - = do { pred1' <- zonkTcPredType pred1 - ; pred2' <- zonkTcPredType pred2 - ; let { pred1'' = tidyPred tidy_env pred1' - ; pred2'' = tidyPred tidy_env pred2' } - ; let msg = vcat [ptext (sLit "When using functional dependencies to combine"), - nest 2 (sep [ppr pred1'' <> comma, nest 2 from1]), - nest 2 (sep [ppr pred2'' <> comma, nest 2 from2])] - ; return (tidy_env, msg) } -\end{code} - -Note [Dictionary Improvement] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -In reduceContext, we first reduce equalities and then class constraints. -However, the letter may expose further opportunities for the former. Hence, -we need to go around again if dictionary reduction produced any dictionary -bindings. The following example demonstrated the point: - - data EX _x _y (p :: * -> *) - data ANY - - class Base p - - class Base (Def p) => Prop p where - type Def p - - instance Base () - instance Prop () where - type Def () = () - - instance (Base (Def (p ANY))) => Base (EX _x _y p) - instance (Prop (p ANY)) => Prop (EX _x _y p) where - type Def (EX _x _y p) = EX _x _y p - - data FOO x - instance Prop (FOO x) where - type Def (FOO x) = () - - data BAR - instance Prop BAR where - type Def BAR = EX () () FOO - -During checking the last instance declaration, we need to check the superclass -cosntraint Base (Def BAR), which family normalisation reduced to -Base (EX () () FOO). Chasing the instance for Base (EX _x _y p), gives us -Base (Def (FOO ANY)), which again requires family normalisation of Def to -Base () before we can finish. - - -The main context-reduction function is @reduce@. Here's its game plan. - -\begin{code} -reduceList :: RedEnv -> [Inst] -> Avails -> TcM Avails -reduceList env@(RedEnv {red_stack = (n,stk)}) wanteds state - = do { traceTc (text "reduceList " <+> (ppr wanteds $$ ppr state)) - ; dopts <- getDOpts - ; when (debugIsOn && (n > 8)) $ do - debugDumpTcRn (hang (ptext (sLit "Interesting! Context reduction stack depth") <+> int n) - 2 (ifPprDebug (nest 2 (pprStack stk)))) - ; if n >= ctxtStkDepth dopts then - failWithTc (reduceDepthErr n stk) - else - go wanteds state } - where - go [] state = return state - go (w:ws) state = do { state' <- reduce (env {red_stack = (n+1, w:stk)}) w state - ; go ws state' } - - -- Base case: we're done! -reduce :: RedEnv -> Inst -> Avails -> TcM Avails -reduce env wanted avails - - -- We don't reduce equalities here (and they must not end up as irreds - -- in the Avails!) - | isEqInst wanted - = return avails - - -- It's the same as an existing inst, or a superclass thereof - | Just _ <- findAvail avails wanted - = do { traceTc (text "reduce: found " <+> ppr wanted) - ; return avails - } - - | otherwise - = do { traceTc (text "reduce" <+> ppr wanted $$ ppr avails) - ; case red_try_me env wanted of { - Stop -> try_simple (addIrred NoSCs); - -- See Note [No superclasses for Stop] - - ReduceMe -> do -- It should be reduced - { (avails, lookup_result) <- reduceInst env avails wanted - ; case lookup_result of - NoInstance -> addIrred AddSCs avails wanted - -- Add it and its superclasses - - GenInst [] rhs -> addWanted AddSCs avails wanted rhs [] - - GenInst wanteds' rhs - -> do { avails1 <- addIrred NoSCs avails wanted - ; avails2 <- reduceList env wanteds' avails1 - ; addWanted AddSCs avails2 wanted rhs wanteds' } } - -- Temporarily do addIrred *before* the reduceList, - -- which has the effect of adding the thing we are trying - -- to prove to the database before trying to prove the things it - -- needs. See note [RECURSIVE DICTIONARIES] - -- NB: we must not do an addWanted before, because that adds the - -- superclasses too, and that can lead to a spurious loop; see - -- the examples in [SUPERCLASS-LOOP] - -- So we do an addIrred before, and then overwrite it afterwards with addWanted - } } - where - -- First, see if the inst can be reduced to a constant in one step - -- Works well for literals (1::Int) and constant dictionaries (d::Num Int) - -- Don't bother for implication constraints, which take real work - try_simple do_this_otherwise - = do { res <- lookupSimpleInst wanted - ; case res of - GenInst [] rhs -> addWanted AddSCs avails wanted rhs [] - _ -> do_this_otherwise avails wanted } -\end{code} - - -Note [RECURSIVE DICTIONARIES] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider - data D r = ZeroD | SuccD (r (D r)); - - instance (Eq (r (D r))) => Eq (D r) where - ZeroD == ZeroD = True - (SuccD a) == (SuccD b) = a == b - _ == _ = False; - - equalDC :: D [] -> D [] -> Bool; - equalDC = (==); - -We need to prove (Eq (D [])). Here's how we go: - - d1 : Eq (D []) - -by instance decl, holds if - d2 : Eq [D []] - where d1 = dfEqD d2 - -by instance decl of Eq, holds if - d3 : D [] - where d2 = dfEqList d3 - d1 = dfEqD d2 - -But now we can "tie the knot" to give - - d3 = d1 - d2 = dfEqList d3 - d1 = dfEqD d2 - -and it'll even run! The trick is to put the thing we are trying to prove -(in this case Eq (D []) into the database before trying to prove its -contributing clauses. - -Note [SUPERCLASS-LOOP 2] -~~~~~~~~~~~~~~~~~~~~~~~~ -We need to be careful when adding "the constaint we are trying to prove". -Suppose we are *given* d1:Ord a, and want to deduce (d2:C [a]) where - - class Ord a => C a where - instance Ord [a] => C [a] where ... - -Then we'll use the instance decl to deduce C [a] from Ord [a], and then add the -superclasses of C [a] to avails. But we must not overwrite the binding -for Ord [a] (which is obtained from Ord a) with a superclass selection or we'll just -build a loop! - -Here's another variant, immortalised in tcrun020 - class Monad m => C1 m - class C1 m => C2 m x - instance C2 Maybe Bool -For the instance decl we need to build (C1 Maybe), and it's no good if -we run around and add (C2 Maybe Bool) and its superclasses to the avails -before we search for C1 Maybe. - -Here's another example - class Eq b => Foo a b - instance Eq a => Foo [a] a -If we are reducing - (Foo [t] t) - -we'll first deduce that it holds (via the instance decl). We must not -then overwrite the Eq t constraint with a superclass selection! - -At first I had a gross hack, whereby I simply did not add superclass constraints -in addWanted, though I did for addGiven and addIrred. This was sub-optimal, -becuase it lost legitimate superclass sharing, and it still didn't do the job: -I found a very obscure program (now tcrun021) in which improvement meant the -simplifier got two bites a the cherry... so something seemed to be an Stop -first time, but reducible next time. - -Now we implement the Right Solution, which is to check for loops directly -when adding superclasses. It's a bit like the occurs check in unification. - - - -%************************************************************************ -%* * - Reducing a single constraint -%* * -%************************************************************************ - -\begin{code} ---------------------------------------------- -reduceInst :: RedEnv -> Avails -> Inst -> TcM (Avails, LookupInstResult) -reduceInst _ avails other_inst - = do { result <- lookupSimpleInst other_inst - ; return (avails, result) } -\end{code} - -Note [Equational Constraints in Implication Constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -An implication constraint is of the form - Given => Wanted -where Given and Wanted may contain both equational and dictionary -constraints. The delay and reduction of these two kinds of constraints -is distinct: - --) In the generated code, wanted Dictionary constraints are wrapped up in an - implication constraint that is created at the code site where the wanted - dictionaries can be reduced via a let-binding. This let-bound implication - constraint is deconstructed at the use-site of the wanted dictionaries. - --) While the reduction of equational constraints is also delayed, the delay - is not manifest in the generated code. The required evidence is generated - in the code directly at the use-site. There is no let-binding and deconstruction - necessary. The main disadvantage is that we cannot exploit sharing as the - same evidence may be generated at multiple use-sites. However, this disadvantage - is limited because it only concerns coercions which are erased. - -The different treatment is motivated by the different in representation. Dictionary -constraints require manifest runtime dictionaries, while equations require coercions -which are types. - -\begin{code} ---------------------------------------------- -reduceImplication :: RedEnv - -> Inst - -> TcM (TcDictBinds, [Inst]) -\end{code} - -Suppose we are simplifying the constraint - forall bs. extras => wanted -in the context of an overall simplification problem with givens 'givens'. - -Note that - * The 'givens' need not mention any of the quantified type variables - e.g. forall {}. Eq a => Eq [a] - forall {}. C Int => D (Tree Int) - - This happens when you have something like - data T a where - T1 :: Eq a => a -> T a - - f :: T a -> Int - f x = ...(case x of { T1 v -> v==v })... - -\begin{code} - -- ToDo: should we instantiate tvs? I think it's not necessary - -- - -- Note on coercion variables: - -- - -- The extra given coercion variables are bound at two different - -- sites: - -- - -- -) in the creation context of the implication constraint - -- the solved equational constraints use these binders - -- - -- -) at the solving site of the implication constraint - -- the solved dictionaries use these binders; - -- these binders are generated by reduceImplication - -- - -- Note [Binders for equalities] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- To reuse the binders of local/given equalities in the binders of - -- implication constraints, it is crucial that these given equalities - -- always have the form - -- cotv :: t1 ~ t2 - -- where cotv is a simple coercion type variable (and not a more - -- complex coercion term). We require that the extra_givens always - -- have this form and exploit the special form when generating binders. -reduceImplication env - orig_implic@(ImplicInst { tci_name = name, tci_loc = inst_loc, - tci_tyvars = tvs, - tci_given = extra_givens, tci_wanted = wanteds - }) - = do { -- Solve the sub-problem - ; let try_me _ = ReduceMe -- Note [Freeness and implications] - env' = env { red_givens = extra_givens ++ red_givens env - , red_doc = sep [ptext (sLit "reduceImplication for") - <+> ppr name, - nest 2 (parens $ ptext (sLit "within") - <+> red_doc env)] - , red_try_me = try_me } - - ; traceTc (text "reduceImplication" <+> vcat - [ ppr (red_givens env), ppr extra_givens, - ppr wanteds]) - ; (irreds, binds) <- checkLoop env' wanteds - - ; traceTc (text "reduceImplication result" <+> vcat - [ppr irreds, ppr binds]) - - ; -- extract superclass binds - -- (sc_binds,_) <- extractResults avails [] --- ; traceTc (text "reduceImplication sc_binds" <+> vcat --- [ppr sc_binds, ppr avails]) --- - - -- SLPJ Sept 07: what if improvement happened inside the checkLoop? - -- Then we must iterate the outer loop too! - - ; didntSolveWantedEqs <- allM wantedEqInstIsUnsolved wanteds - -- we solve wanted eqs by side effect! - - -- Progress is no longer measered by the number of bindings - -- If there are any irreds, but no bindings and no solved - -- equalities, we back off and do nothing - ; let backOff = isEmptyLHsBinds binds && -- no new bindings - (not $ null irreds) && -- but still some irreds - didntSolveWantedEqs -- no instantiated cotv - - ; if backOff then -- No progress - return (emptyBag, [orig_implic]) - else do - { (simpler_implic_insts, bind) - <- makeImplicationBind inst_loc tvs extra_givens irreds - -- This binding is useless if the recursive simplification - -- made no progress; but currently we don't try to optimise that - -- case. After all, we only try hard to reduce at top level, or - -- when inferring types. - - ; let -- extract Id binders for dicts and CoTyVar binders for eqs; - -- see Note [Binders for equalities] - (extra_eq_givens, extra_dict_givens) = partition isEqInst - extra_givens - eq_cotvs = map instToVar extra_eq_givens - dict_ids = map instToId extra_dict_givens - - co = mkWpTyLams tvs - <.> mkWpTyLams eq_cotvs - <.> mkWpLams dict_ids - <.> WpLet (binds `unionBags` bind) - rhs = mkLHsWrap co payload - loc = instLocSpan inst_loc - -- wanted equalities are solved by updating their - -- cotv; we don't generate bindings for them - dict_bndrs = map (L loc . HsVar . instToId) - . filter (not . isEqInst) - $ wanteds - payload = mkBigLHsTup dict_bndrs - - ; traceTc (vcat [text "reduceImplication" <+> ppr name, - ppr simpler_implic_insts, - text "->" <+> ppr rhs]) - ; return (unitBag (L loc (VarBind { var_id= instToId orig_implic - , var_rhs = rhs - , var_inline = notNull dict_ids } - -- See Note [Always inline implication constraints] - )), - simpler_implic_insts) - } - } -reduceImplication _ i = pprPanic "reduceImplication" (ppr i) -\end{code} - -Note [Always inline implication constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose an implication constraint floats out of an INLINE function. -Then although the implication has a single call site, it won't be -inlined. And that is bad because it means that even if there is really -*no* overloading (type signatures specify the exact types) there will -still be dictionary passing in the resulting code. To avert this, -we mark the implication constraints themselves as INLINE, at least when -there is no loss of sharing as a result. - -Note [Freeness and implications] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's hard to say when an implication constraint can be floated out. Consider - forall {} Eq a => Foo [a] -The (Foo [a]) doesn't mention any of the quantified variables, but it -still might be partially satisfied by the (Eq a). - -There is a useful special case when it *is* easy to partition the -constraints, namely when there are no 'givens'. Consider - forall {a}. () => Bar b -There are no 'givens', and so there is no reason to capture (Bar b). -We can let it float out. But if there is even one constraint we -must be much more careful: - forall {a}. C a b => Bar (m b) -because (C a b) might have a superclass (D b), from which we might -deduce (Bar [b]) when m later gets instantiated to []. Ha! - -Here is an even more exotic example - class C a => D a b -Now consider the constraint - forall b. D Int b => C Int -We can satisfy the (C Int) from the superclass of D, so we don't want -to float the (C Int) out, even though it mentions no type variable in -the constraints! - -One more example: the constraint - class C a => D a b - instance (C a, E c) => E (a,c) - - constraint: forall b. D Int b => E (Int,c) - -You might think that the (D Int b) can't possibly contribute -to solving (E (Int,c)), since the latter mentions 'c'. But -in fact it can, because solving the (E (Int,c)) constraint needs -dictionaries - C Int, E c -and the (C Int) can be satisfied from the superclass of (D Int b). -So we must still not float (E (Int,c)) out. - -To think about: special cases for unary type classes? - -Note [Pruning the givens in an implication constraint] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose we are about to form the implication constraint - forall tvs. Eq a => Ord b -The (Eq a) cannot contribute to the (Ord b), because it has no access to -the type variable 'b'. So we could filter out the (Eq a) from the givens. -But BE CAREFUL of the examples above in [Freeness and implications]. - -Doing so would be a bit tidier, but all the implication constraints get -simplified away by the optimiser, so it's no great win. So I don't take -advantage of that at the moment. - -If you do, BE CAREFUL of wobbly type variables. - - -%************************************************************************ -%* * - Avails and AvailHow: the pool of evidence -%* * -%************************************************************************ - - -\begin{code} -data Avails = Avails !ImprovementDone !AvailEnv - -type ImprovementDone = Bool -- True <=> some unification has happened - -- so some Irreds might now be reducible - -- keys that are now - -type AvailEnv = FiniteMap Inst AvailHow -data AvailHow - = IsIrred -- Used for irreducible dictionaries, - -- which are going to be lambda bound - - | Given Inst -- Used for dictionaries for which we have a binding - -- e.g. those "given" in a signature - - | Rhs -- Used when there is a RHS - (LHsExpr TcId) -- The RHS - [Inst] -- Insts free in the RHS; we need these too - -instance Outputable Avails where - ppr = pprAvails - -pprAvails :: Avails -> SDoc -pprAvails (Avails imp avails) - = vcat [ ptext (sLit "Avails") <> (if imp then ptext (sLit "[improved]") else empty) - , nest 2 $ braces $ - vcat [ sep [ppr inst, nest 2 (equals <+> ppr avail)] - | (inst,avail) <- Map.toList avails ]] - -instance Outputable AvailHow where - ppr = pprAvail - -------------------------- -pprAvail :: AvailHow -> SDoc -pprAvail IsIrred = text "Irred" -pprAvail (Given x) = text "Given" <+> ppr x -pprAvail (Rhs rhs bs) = sep [text "Rhs" <+> ppr bs, - nest 2 (ppr rhs)] - -------------------------- -extendAvailEnv :: AvailEnv -> Inst -> AvailHow -> AvailEnv -extendAvailEnv env inst avail = Map.insert inst avail env - -findAvailEnv :: AvailEnv -> Inst -> Maybe AvailHow -findAvailEnv env wanted = Map.lookup wanted env - -- NB 1: the Ord instance of Inst compares by the class/type info - -- *not* by unique. So - -- d1::C Int == d2::C Int - -emptyAvails :: Avails -emptyAvails = Avails False emptyFM - -findAvail :: Avails -> Inst -> Maybe AvailHow -findAvail (Avails _ avails) wanted = findAvailEnv avails wanted - -elemAvails :: Inst -> Avails -> Bool -elemAvails wanted (Avails _ avails) = wanted `elemFM` avails - -extendAvails :: Avails -> Inst -> AvailHow -> TcM Avails --- Does improvement -extendAvails avails@(Avails imp env) inst avail - = do { imp1 <- tcImproveOne avails inst -- Do any improvement - ; return (Avails (imp || imp1) (extendAvailEnv env inst avail)) } - -availsInsts :: Avails -> [Inst] -availsInsts (Avails _ avails) = Map.keys avails - -availsImproved :: Avails -> ImprovementDone -availsImproved (Avails imp _) = imp -\end{code} - -Extracting the bindings from a bunch of Avails. -The bindings do *not* come back sorted in dependency order. -We assume that they'll be wrapped in a big Rec, so that the -dependency analyser can sort them out later - -\begin{code} -type DoneEnv = FiniteMap Inst [Id] --- Tracks which things we have evidence for - -extractResults :: Avails - -> [Inst] -- Wanted - -> TcM (TcDictBinds, -- Bindings - [Inst], -- The insts bound by the bindings - [Inst]) -- Irreducible ones - -- Note [Reducing implication constraints] - -extractResults (Avails _ avails) wanteds - = go emptyBag [] [] emptyFM wanteds - where - go :: TcDictBinds -- Bindings for dicts - -> [Inst] -- Bound by the bindings - -> [Inst] -- Irreds - -> DoneEnv -- Has an entry for each inst in the above three sets - -> [Inst] -- Wanted - -> TcM (TcDictBinds, [Inst], [Inst]) - go binds bound_dicts irreds _ [] - = return (binds, bound_dicts, irreds) - - go binds bound_dicts irreds done (w:ws) - | isEqInst w - = go binds bound_dicts (w:irreds) done' ws - - | Just done_ids@(done_id : rest_done_ids) <- Map.lookup w done - = if w_id `elem` done_ids then - go binds bound_dicts irreds done ws - else - go (add_bind (nlHsVar done_id)) bound_dicts irreds - (Map.insert w (done_id : w_id : rest_done_ids) done) ws - - | otherwise -- Not yet done - = case findAvailEnv avails w of - Nothing -> pprTrace "Urk: extractResults" (ppr w) $ - go binds bound_dicts irreds done ws - - Just IsIrred -> go binds bound_dicts (w:irreds) done' ws - - Just (Rhs rhs ws') -> go (add_bind rhs) (w:bound_dicts) irreds done' (ws' ++ ws) - - Just (Given g) -> go binds' bound_dicts irreds (Map.insert w [g_id] done) ws - where - g_id = instToId g - binds' | w_id == g_id = binds - | otherwise = add_bind (nlHsVar g_id) - where - w_id = instToId w - done' = Map.insert w [w_id] done - add_bind rhs = addInstToDictBind binds w rhs -\end{code} - - -Note [No superclasses for Stop] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we decide not to reduce an Inst -- the 'WhatToDo' --- we still -add it to avails, so that any other equal Insts will be commoned up -right here. However, we do *not* add superclasses. If we have - df::Floating a - dn::Num a -but a is not bound here, then we *don't* want to derive dn from df -here lest we lose sharing. - -\begin{code} -addWanted :: WantSCs -> Avails -> Inst -> LHsExpr TcId -> [Inst] -> TcM Avails -addWanted want_scs avails wanted rhs_expr wanteds - = addAvailAndSCs want_scs avails wanted avail - where - avail = Rhs rhs_expr wanteds - -addGiven :: Avails -> Inst -> TcM Avails -addGiven avails given - = addAvailAndSCs want_scs avails given (Given given) - where - want_scs = case instLocOrigin (instLoc given) of - NoScOrigin -> NoSCs - _other -> AddSCs - -- Conditionally add superclasses for 'given' - -- See Note [Recursive instances and superclases] - - -- No ASSERT( not (given `elemAvails` avails) ) because in an - -- instance decl for Ord t we can add both Ord t and Eq t as - -- 'givens', so the assert isn't true -\end{code} - -\begin{code} -addIrred :: WantSCs -> Avails -> Inst -> TcM Avails -addIrred want_scs avails irred = ASSERT2( not (irred `elemAvails` avails), ppr irred $$ ppr avails ) - addAvailAndSCs want_scs avails irred IsIrred - -addAvailAndSCs :: WantSCs -> Avails -> Inst -> AvailHow -> TcM Avails -addAvailAndSCs want_scs avails inst avail - | not (isClassDict inst) = extendAvails avails inst avail - | NoSCs <- want_scs = extendAvails avails inst avail - | otherwise = do { traceTc (text "addAvailAndSCs" <+> vcat [ppr inst, ppr deps]) - ; avails' <- extendAvails avails inst avail - ; addSCs is_loop avails' inst } - where - is_loop pred = any (`tcEqType` mkPredTy pred) dep_tys - -- Note: this compares by *type*, not by Unique - deps = findAllDeps (unitVarSet (instToVar inst)) avail - dep_tys = map idType (varSetElems deps) - - findAllDeps :: IdSet -> AvailHow -> IdSet - -- Find all the Insts that this one depends on - -- See Note [SUPERCLASS-LOOP 2] - -- Watch out, though. Since the avails may contain loops - -- (see Note [RECURSIVE DICTIONARIES]), so we need to track the ones we've seen so far - findAllDeps so_far (Rhs _ kids) = foldl find_all so_far kids - findAllDeps so_far _ = so_far - - find_all :: IdSet -> Inst -> IdSet - find_all so_far kid - | isEqInst kid = so_far - | kid_id `elemVarSet` so_far = so_far - | Just avail <- findAvail avails kid = findAllDeps so_far' avail - | otherwise = so_far' - where - so_far' = extendVarSet so_far kid_id -- Add the new kid to so_far - kid_id = instToId kid - -addSCs :: (TcPredType -> Bool) -> Avails -> Inst -> TcM Avails - -- Add all the superclasses of the Inst to Avails - -- The first param says "don't do this because the original thing - -- depends on this one, so you'd build a loop" - -- Invariant: the Inst is already in Avails. - -addSCs is_loop avails dict - = ASSERT( isDict dict ) - do { sc_dicts <- newCtGivens (instLoc dict) sc_theta' - ; foldlM add_sc avails (zipEqual "add_scs" sc_dicts sc_sels) } - where - (clas, tys) = getDictClassTys dict - (tyvars, sc_theta, sc_sels, _) = classBigSig clas - sc_theta' = filter (not . isEqPred) $ - substTheta (zipTopTvSubst tyvars tys) sc_theta - - add_sc avails (sc_dict, sc_sel) - | is_loop (dictPred sc_dict) = return avails -- See Note [SUPERCLASS-LOOP 2] - | is_given sc_dict = return avails - | otherwise = do { avails' <- extendAvails avails sc_dict (Rhs sc_sel_rhs [dict]) - ; addSCs is_loop avails' sc_dict } - where - sc_sel_rhs = L (instSpan dict) (HsWrap co_fn (HsVar sc_sel)) - co_fn = WpApp (instToVar dict) <.> mkWpTyApps tys - - is_given :: Inst -> Bool - is_given sc_dict = case findAvail avails sc_dict of - Just (Given _) -> True -- Given is cheaper than superclass selection - _ -> False - --- From the a set of insts obtain all equalities that (transitively) occur in --- superclass contexts of class constraints (aka the ancestor equalities). --- -ancestorEqualities :: [Inst] -> TcM [Inst] -ancestorEqualities - = mapM mkWantedEqInst -- turn only equality predicates.. - . filter isEqPred -- ..into wanted equality insts - . bagToList - . addAEsToBag emptyBag -- collect the superclass constraints.. - . map dictPred -- ..of all predicates in a bag - . filter isClassDict - where - addAEsToBag :: Bag PredType -> [PredType] -> Bag PredType - addAEsToBag bag [] = bag - addAEsToBag bag (pred:preds) - | pred `elemBag` bag = addAEsToBag bag preds - | isEqPred pred = addAEsToBag bagWithPred preds - | isClassPred pred = addAEsToBag bagWithPred predsWithSCs - | otherwise = addAEsToBag bag preds - where - bagWithPred = bag `snocBag` pred - predsWithSCs = preds ++ substTheta (zipTopTvSubst tyvars tys) sc_theta - -- - (tyvars, sc_theta, _, _) = classBigSig clas - (clas, tys) = getClassPredTys pred -\end{code} - - -%************************************************************************ -%* * -\section{tcSimplifyTop: defaulting} -%* * -%************************************************************************ - - -@tcSimplifyTop@ is called once per module to simplify all the constant -and ambiguous Insts. - -We need to be careful of one case. Suppose we have - - instance Num a => Num (Foo a b) where ... - -and @tcSimplifyTop@ is given a constraint (Num (Foo x y)). Then it'll simplify -to (Num x), and default x to Int. But what about y?? - -It's OK: the final zonking stage should zap y to (), which is fine. - - -\begin{code} -tcSimplifyTop, tcSimplifyInteractive :: [Inst] -> TcM TcDictBinds -tcSimplifyTop wanteds - = tc_simplify_top doc False wanteds - where - doc = text "tcSimplifyTop" - -tcSimplifyInteractive wanteds - = tc_simplify_top doc True wanteds - where - doc = text "tcSimplifyInteractive" - --- The TcLclEnv should be valid here, solely to improve --- error message generation for the monomorphism restriction -tc_simplify_top :: SDoc -> Bool -> [Inst] -> TcM (Bag (LHsBind TcId)) -tc_simplify_top doc interactive wanteds - = do { dflags <- getDOpts - ; wanteds <- zonkInsts wanteds - ; mapM_ zonkTopTyVar (varSetElems (tyVarsOfInsts wanteds)) - - ; traceTc (text "tc_simplify_top 0: " <+> ppr wanteds) - ; (irreds1, binds1) <- tryHardCheckLoop doc1 wanteds --- ; (irreds1, binds1) <- gentleInferLoop doc1 wanteds - ; traceTc (text "tc_simplify_top 1: " <+> ppr irreds1) - ; (irreds2, binds2) <- approximateImplications doc2 (\_ -> True) irreds1 - ; traceTc (text "tc_simplify_top 2: " <+> ppr irreds2) - - -- Use the defaulting rules to do extra unification - -- NB: irreds2 are already zonked - ; (irreds3, binds3) <- disambiguate doc3 interactive dflags irreds2 - - -- Deal with implicit parameters - ; let (bad_ips, non_ips) = partition isIPDict irreds3 - (ambigs, others) = partition isTyVarDict non_ips - - ; topIPErrs bad_ips -- Can arise from f :: Int -> Int - -- f x = x + ?y - ; addNoInstanceErrs others - ; addTopAmbigErrs ambigs - - ; return (binds1 `unionBags` binds2 `unionBags` binds3) } - where - doc1 = doc <+> ptext (sLit "(first round)") - doc2 = doc <+> ptext (sLit "(approximate)") - doc3 = doc <+> ptext (sLit "(disambiguate)") -\end{code} - -If a dictionary constrains a type variable which is - * not mentioned in the environment - * and not mentioned in the type of the expression -then it is ambiguous. No further information will arise to instantiate -the type variable; nor will it be generalised and turned into an extra -parameter to a function. - -It is an error for this to occur, except that Haskell provided for -certain rules to be applied in the special case of numeric types. -Specifically, if - * at least one of its classes is a numeric class, and - * all of its classes are numeric or standard -then the type variable can be defaulted to the first type in the -default-type list which is an instance of all the offending classes. - -So here is the function which does the work. It takes the ambiguous -dictionaries and either resolves them (producing bindings) or -complains. It works by splitting the dictionary list by type -variable, and using @disambigOne@ to do the real business. - -@disambigOne@ assumes that its arguments dictionaries constrain all -the same type variable. - -ADR Comment 20/6/94: I've changed the @CReturnable@ case to default to -@()@ instead of @Int@. I reckon this is the Right Thing to do since -the most common use of defaulting is code like: -\begin{verbatim} - _ccall_ foo `seqPrimIO` bar -\end{verbatim} -Since we're not using the result of @foo@, the result if (presumably) -@void@. - -\begin{code} -disambiguate :: SDoc -> Bool -> DynFlags -> [Inst] -> TcM ([Inst], TcDictBinds) - -- Just does unification to fix the default types - -- The Insts are assumed to be pre-zonked -disambiguate doc interactive dflags insts - | null insts - = return (insts, emptyBag) - - | null defaultable_groups - = do { traceTc (text "disambigutate, no defaultable groups" <+> vcat [ppr unaries, ppr insts, ppr bad_tvs, ppr defaultable_groups]) - ; return (insts, emptyBag) } - - | otherwise - = do { -- Figure out what default types to use - default_tys <- getDefaultTys extended_defaulting ovl_strings - - ; traceTc (text "disambiguate1" <+> vcat [ppr insts, ppr unaries, ppr bad_tvs, ppr defaultable_groups]) - ; mapM_ (disambigGroup default_tys) defaultable_groups - - -- disambigGroup does unification, hence try again - ; tryHardCheckLoop doc insts } - - where - extended_defaulting = interactive || dopt Opt_ExtendedDefaultRules dflags - -- See also Trac #1974 - ovl_strings = dopt Opt_OverloadedStrings dflags - - unaries :: [(Inst, Class, TcTyVar)] -- (C tv) constraints - bad_tvs :: TcTyVarSet -- Tyvars mentioned by *other* constraints - (unaries, bad_tvs_s) = partitionWith find_unary insts - bad_tvs = unionVarSets bad_tvs_s - - -- Finds unary type-class constraints - find_unary d@(Dict {tci_pred = ClassP cls [ty]}) - | Just tv <- tcGetTyVar_maybe ty = Left (d,cls,tv) - find_unary inst = Right (tyVarsOfInst inst) - - -- Group by type variable - defaultable_groups :: [[(Inst,Class,TcTyVar)]] - defaultable_groups = filter defaultable_group (equivClasses cmp_tv unaries) - cmp_tv (_,_,tv1) (_,_,tv2) = tv1 `compare` tv2 - - defaultable_group :: [(Inst,Class,TcTyVar)] -> Bool - defaultable_group ds@((_,_,tv):_) - = isTyConableTyVar tv -- Note [Avoiding spurious errors] - && not (tv `elemVarSet` bad_tvs) - && defaultable_classes [c | (_,c,_) <- ds] - defaultable_group [] = panic "defaultable_group" - - defaultable_classes clss - | extended_defaulting = any isInteractiveClass clss - | otherwise = all is_std_class clss && (any is_num_class clss) - - -- In interactive mode, or with -XExtendedDefaultRules, - -- we default Show a to Show () to avoid graututious errors on "show []" - isInteractiveClass cls - = is_num_class cls || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey]) - - is_num_class cls = isNumericClass cls || (ovl_strings && (cls `hasKey` isStringClassKey)) - -- is_num_class adds IsString to the standard numeric classes, - -- when -foverloaded-strings is enabled - - is_std_class cls = isStandardClass cls || (ovl_strings && (cls `hasKey` isStringClassKey)) - -- Similarly is_std_class - ------------------------ -disambigGroup :: [Type] -- The default types - -> [(Inst,Class,TcTyVar)] -- All standard classes of form (C a) - -> TcM () -- Just does unification, to fix the default types - -disambigGroup default_tys dicts - = do { mb_chosen_ty <- try_default default_tys - ; case mb_chosen_ty of - Nothing -> return () - Just chosen_ty -> do { _ <- unifyType chosen_ty (mkTyVarTy tyvar) - ; warnDefault dicts chosen_ty } } - where - (_,_,tyvar) = ASSERT(not (null dicts)) head dicts -- Should be non-empty - classes = [c | (_,c,_) <- dicts] - - try_default [] = return Nothing - try_default (default_ty : default_tys) - = tryTcLIE_ (try_default default_tys) $ - do { tcSimplifyDefault [mkClassPred clas [default_ty] | clas <- classes] - -- This may fail; then the tryTcLIE_ kicks in - -- Failure here is caused by there being no type in the - -- default list which can satisfy all the ambiguous classes. - -- For example, if Real a is reqd, but the only type in the - -- default list is Int. - - ; return (Just default_ty) -- TOMDO: do something with the coercion - } - - ------------------------ -getDefaultTys :: Bool -> Bool -> TcM [Type] -getDefaultTys extended_deflts ovl_strings - = do { mb_defaults <- getDeclaredDefaultTys - ; case mb_defaults of { - Just tys -> return tys ; -- User-supplied defaults - Nothing -> do - - -- No use-supplied default - -- Use [Integer, Double], plus modifications - { integer_ty <- tcMetaTy integerTyConName - ; checkWiredInTyCon doubleTyCon - ; string_ty <- tcMetaTy stringTyConName - ; return (opt_deflt extended_deflts unitTy - -- Note [Default unitTy] - ++ - [integer_ty,doubleTy] - ++ - opt_deflt ovl_strings string_ty) } } } - where - opt_deflt True ty = [ty] - opt_deflt False _ = [] -\end{code} - -Note [Default unitTy] -~~~~~~~~~~~~~~~~~~~~~ -In interative mode (or with -XExtendedDefaultRules) we add () as the first type we -try when defaulting. This has very little real impact, except in the following case. -Consider: - Text.Printf.printf "hello" -This has type (forall a. IO a); it prints "hello", and returns 'undefined'. We don't -want the GHCi repl loop to try to print that 'undefined'. The neatest thing is to -default the 'a' to (), rather than to Integer (which is what would otherwise happen; -and then GHCi doesn't attempt to print the (). So in interactive mode, we add -() to the list of defaulting types. See Trac #1200. - -Note [Avoiding spurious errors] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When doing the unification for defaulting, we check for skolem -type variables, and simply don't default them. For example: - f = (*) -- Monomorphic - g :: Num a => a -> a - g x = f x x -Here, we get a complaint when checking the type signature for g, -that g isn't polymorphic enough; but then we get another one when -dealing with the (Num a) context arising from f's definition; -we try to unify a with Int (to default it), but find that it's -already been unified with the rigid variable from g's type sig - - -%************************************************************************ -%* * -\subsection[simple]{@Simple@ versions} -%* * -%************************************************************************ - -Much simpler versions when there are no bindings to make! - -@tcSimplifyThetas@ simplifies class-type constraints formed by -@deriving@ declarations and when specialising instances. We are -only interested in the simplified bunch of class/type constraints. - -It simplifies to constraints of the form (C a b c) where -a,b,c are type variables. This is required for the context of -instance declarations. - -\begin{code} -tcSimplifyDeriv :: InstOrigin - -> [TyVar] - -> ThetaType -- Wanted - -> TcM ThetaType -- Needed --- Given instance (wanted) => C inst_ty --- Simplify 'wanted' as much as possible - -tcSimplifyDeriv orig tyvars theta - = do { (tvs, _, tenv) <- tcInstTyVars tyvars - -- The main loop may do unification, and that may crash if - -- it doesn't see a TcTyVar, so we have to instantiate. Sigh - -- ToDo: what if two of them do get unified? - ; wanteds <- newCtGivensO orig (substTheta tenv theta) - ; (irreds, _) <- tryHardCheckLoop doc wanteds - - ; let (tv_dicts, others) = partition ok irreds - (tidy_env, tidy_insts) = tidyInsts others - ; reportNoInstances tidy_env Nothing [alt_fix] tidy_insts - -- See Note [Exotic derived instance contexts] in TcMType - - ; let rev_env = zipTopTvSubst tvs (mkTyVarTys tyvars) - simpl_theta = substTheta rev_env (map dictPred tv_dicts) - -- This reverse-mapping is a pain, but the result - -- should mention the original TyVars not TcTyVars - - ; return simpl_theta } - where - doc = ptext (sLit "deriving classes for a data type") - - ok dict | isDict dict = validDerivPred (dictPred dict) - | otherwise = False - alt_fix = vcat [ptext (sLit "use a standalone 'deriving instance' declaration instead,"), - ptext (sLit "so you can specify the instance context yourself")] -\end{code} - - -@tcSimplifyDefault@ just checks class-type constraints, essentially; -used with \tr{default} declarations. We are only interested in -whether it worked or not. - -\begin{code} -tcSimplifyDefault :: ThetaType -- Wanted; has no type variables in it - -> TcM () - -tcSimplifyDefault theta = do - wanteds <- newCtGivensO DefaultOrigin theta - (irreds, _) <- tryHardCheckLoop doc wanteds - addNoInstanceErrs irreds - if null irreds then - return () - else - traceTc (ptext (sLit "tcSimplifyDefault failing")) >> failM - where - doc = ptext (sLit "default declaration") -\end{code} - - - -%************************************************************************ -%* * -\section{Errors and contexts} -%* * -%************************************************************************ - -ToDo: for these error messages, should we note the location as coming -from the insts, or just whatever seems to be around in the monad just -now? - -\begin{code} -groupErrs :: ([Inst] -> TcM ()) -- Deal with one group - -> [Inst] -- The offending Insts - -> TcM () --- Group together insts with the same origin --- We want to report them together in error messages - -groupErrs _ [] - = return () -groupErrs report_err (inst:insts) - = do { do_one (inst:friends) - ; groupErrs report_err others } - where - -- (It may seem a bit crude to compare the error messages, - -- but it makes sure that we combine just what the user sees, - -- and it avoids need equality on InstLocs.) - (friends, others) = partition is_friend insts - loc_msg = showSDoc (pprInstLoc (instLoc inst)) - is_friend friend = showSDoc (pprInstLoc (instLoc friend)) == loc_msg - do_one insts = setInstCtxt (instLoc (head insts)) (report_err insts) - -- Add location and context information derived from the Insts - --- Add the "arising from..." part to a message about bunch of dicts -addInstLoc :: [Inst] -> Message -> Message -addInstLoc insts msg = msg $$ nest 2 (pprInstArising (head insts)) - -addTopIPErrs :: [Name] -> [Inst] -> TcM () -addTopIPErrs _ [] - = return () -addTopIPErrs bndrs ips - = do { dflags <- getDOpts - ; addErrTcM (tidy_env, mk_msg dflags tidy_ips) } - where - (tidy_env, tidy_ips) = tidyInsts ips - mk_msg dflags ips - = vcat [sep [ptext (sLit "Implicit parameters escape from"), - nest 2 (ptext (sLit "the monomorphic top-level binding") - <> plural bndrs <+> ptext (sLit "of") - <+> pprBinders bndrs <> colon)], - nest 2 (vcat (map ppr_ip ips)), - monomorphism_fix dflags] - ppr_ip ip = pprPred (dictPred ip) <+> pprInstArising ip - -topIPErrs :: [Inst] -> TcM () -topIPErrs dicts - = groupErrs report tidy_dicts - where - (tidy_env, tidy_dicts) = tidyInsts dicts - report dicts = addErrTcM (tidy_env, mk_msg dicts) - mk_msg dicts = addInstLoc dicts (ptext (sLit "Unbound implicit parameter") <> - plural tidy_dicts <+> pprDictsTheta tidy_dicts) - -addNoInstanceErrs :: [Inst] -- Wanted (can include implications) - -> TcM () -addNoInstanceErrs insts - = do { let (tidy_env, tidy_insts) = tidyInsts insts - ; reportNoInstances tidy_env Nothing [] tidy_insts } - -reportNoInstances - :: TidyEnv - -> Maybe (InstLoc, [Inst]) -- Context - -- Nothing => top level - -- Just (d,g) => d describes the construct - -- with givens g - -> [SDoc] -- Alternative fix for no-such-instance - -> [Inst] -- What is wanted (can include implications) - -> TcM () - -reportNoInstances tidy_env mb_what alt_fix insts - = groupErrs (report_no_instances tidy_env mb_what alt_fix) insts - -report_no_instances :: TidyEnv -> Maybe (InstLoc, [Inst]) -> [SDoc] -> [Inst] -> TcM () -report_no_instances tidy_env mb_what alt_fixes insts - = do { inst_envs <- tcGetInstEnvs - ; let (implics, insts1) = partition isImplicInst insts - (insts2, overlaps) = partitionWith (check_overlap inst_envs) insts1 - (eqInsts, insts3) = partition isEqInst insts2 - ; traceTc (text "reportNoInstances" <+> vcat - [ppr insts, ppr implics, ppr insts1, ppr insts2]) - ; mapM_ complain_implic implics - ; mapM_ (\doc -> addErrTcM (tidy_env, doc)) overlaps - ; groupErrs complain_no_inst insts3 - ; mapM_ (addErrTcM . mk_eq_err) eqInsts - } - where - complain_no_inst insts = addErrTcM (tidy_env, mk_no_inst_err insts) - - complain_implic inst -- Recurse! - = reportNoInstances tidy_env - (Just (tci_loc inst, tci_given inst)) - alt_fixes (tci_wanted inst) - - check_overlap :: (InstEnv,InstEnv) -> Inst -> Either Inst SDoc - -- Right msg => overlap message - -- Left inst => no instance - check_overlap inst_envs wanted - | not (isClassDict wanted) = Left wanted - | otherwise - = case lookupInstEnv inst_envs clas tys of - ([], _) -> Left wanted -- No match - -- The case of exactly one match and no unifiers means a - -- successful lookup. That can't happen here, because dicts - -- only end up here if they didn't match in Inst.lookupInst - ([_],[]) - | debugIsOn -> pprPanic "reportNoInstance" (ppr wanted) - res -> Right (mk_overlap_msg wanted res) - where - (clas,tys) = getDictClassTys wanted - - mk_overlap_msg dict (matches, unifiers) - = ASSERT( not (null matches) ) - vcat [ addInstLoc [dict] ((ptext (sLit "Overlapping instances for") - <+> pprPred (dictPred dict))), - sep [ptext (sLit "Matching instances") <> colon, - nest 2 (vcat [pprInstances ispecs, pprInstances unifiers])], - if not (isSingleton matches) - then -- Two or more matches - empty - else -- One match, plus some unifiers - ASSERT( not (null unifiers) ) - parens (vcat [ptext (sLit "The choice depends on the instantiation of") <+> - quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))), - ptext (sLit "To pick the first instance above, use -XIncoherentInstances"), - ptext (sLit "when compiling the other instance declarations")])] - where - ispecs = [ispec | (ispec, _) <- matches] - - mk_eq_err :: Inst -> (TidyEnv, SDoc) - mk_eq_err inst = misMatchMsg tidy_env (eqInstTys inst) - - mk_no_inst_err insts - | null insts = empty - - | Just (loc, givens) <- mb_what, -- Nested (type signatures, instance decls) - not (isEmptyVarSet (tyVarsOfInsts insts)) - = vcat [ addInstLoc insts $ - sep [ ptext (sLit "Could not deduce") <+> pprDictsTheta insts - , nest 2 $ ptext (sLit "from the context") <+> pprDictsTheta givens] - , show_fixes (fix1 loc : fixes2 ++ alt_fixes) ] - - | otherwise -- Top level - = vcat [ addInstLoc insts $ - ptext (sLit "No instance") <> plural insts - <+> ptext (sLit "for") <+> pprDictsTheta insts - , show_fixes (fixes2 ++ alt_fixes) ] - - where - fix1 loc = sep [ ptext (sLit "add") <+> pprDictsTheta insts - <+> ptext (sLit "to the context of"), - nest 2 (ppr (instLocOrigin loc)) ] - -- I'm not sure it helps to add the location - -- nest 2 (ptext (sLit "at") <+> ppr (instLocSpan loc)) ] - - fixes2 | null instance_dicts = [] - | otherwise = [sep [ptext (sLit "add an instance declaration for"), - pprDictsTheta instance_dicts]] - instance_dicts = [d | d <- insts, isClassDict d, not (isTyVarDict d)] - -- Insts for which it is worth suggesting an adding an instance declaration - -- Exclude implicit parameters, and tyvar dicts - - show_fixes :: [SDoc] -> SDoc - show_fixes [] = empty - show_fixes (f:fs) = sep [ptext (sLit "Possible fix:"), - nest 2 (vcat (f : map (ptext (sLit "or") <+>) fs))] - -addTopAmbigErrs :: [Inst] -> TcRn () -addTopAmbigErrs dicts --- Divide into groups that share a common set of ambiguous tyvars - = ifErrsM (return ()) $ -- Only report ambiguity if no other errors happened - -- See Note [Avoiding spurious errors] - mapM_ report (equivClasses cmp [(d, tvs_of d) | d <- tidy_dicts]) - where - (tidy_env, tidy_dicts) = tidyInsts dicts - - tvs_of :: Inst -> [TcTyVar] - tvs_of d = varSetElems (tyVarsOfInst d) - cmp (_,tvs1) (_,tvs2) = tvs1 `compare` tvs2 - - report :: [(Inst,[TcTyVar])] -> TcM () - report pairs@((inst,tvs) : _) = do -- The pairs share a common set of ambiguous tyvars - (tidy_env, mono_msg) <- mkMonomorphismMsg tidy_env tvs - setSrcSpan (instSpan inst) $ - -- the location of the first one will do for the err message - addErrTcM (tidy_env, msg $$ mono_msg) - where - dicts = map fst pairs - msg = sep [text "Ambiguous type variable" <> plural tvs <+> - pprQuotedList tvs <+> in_msg, - nest 2 (pprDictsInFull dicts)] - in_msg = text "in the constraint" <> plural dicts <> colon - report [] = panic "addTopAmbigErrs" - - -mkMonomorphismMsg :: TidyEnv -> [TcTyVar] -> TcM (TidyEnv, Message) --- There's an error with these Insts; if they have free type variables --- it's probably caused by the monomorphism restriction. --- Try to identify the offending variable --- ASSUMPTION: the Insts are fully zonked -mkMonomorphismMsg tidy_env inst_tvs - = do { dflags <- getDOpts - ; (tidy_env, docs) <- findGlobals (mkVarSet inst_tvs) tidy_env - ; return (tidy_env, mk_msg dflags docs) } - where - mk_msg _ _ | any isRuntimeUnk inst_tvs - = vcat [ptext (sLit "Cannot resolve unknown runtime types:") <+> - (pprWithCommas ppr inst_tvs), - ptext (sLit "Use :print or :force to determine these types")] - mk_msg _ [] = ptext (sLit "Probable fix: add a type signature that fixes these type variable(s)") - -- This happens in things like - -- f x = show (read "foo") - -- where monomorphism doesn't play any role - mk_msg dflags docs - = vcat [ptext (sLit "Possible cause: the monomorphism restriction applied to the following:"), - nest 2 (vcat docs), - monomorphism_fix dflags] - -monomorphism_fix :: DynFlags -> SDoc -monomorphism_fix dflags - = ptext (sLit "Probable fix:") <+> vcat - [ptext (sLit "give these definition(s) an explicit type signature"), - if dopt Opt_MonomorphismRestriction dflags - then ptext (sLit "or use -XNoMonomorphismRestriction") - else empty] -- Only suggest adding "-XNoMonomorphismRestriction" - -- if it is not already set! - -warnDefault :: [(Inst, Class, Var)] -> Type -> TcM () -warnDefault ups default_ty = do - warn_flag <- doptM Opt_WarnTypeDefaults - setInstCtxt (instLoc (head (dicts))) (warnTc warn_flag warn_msg) - where - dicts = [d | (d,_,_) <- ups] - - -- Tidy them first - (_, tidy_dicts) = tidyInsts dicts - warn_msg = vcat [ptext (sLit "Defaulting the following constraint(s) to type") <+> - quotes (ppr default_ty), - pprDictsInFull tidy_dicts] - -reduceDepthErr :: Int -> [Inst] -> SDoc -reduceDepthErr n stack - = vcat [ptext (sLit "Context reduction stack overflow; size =") <+> int n, - ptext (sLit "Use -fcontext-stack=N to increase stack size to N"), - nest 4 (pprStack stack)] - -pprStack :: [Inst] -> SDoc -pprStack stack = vcat (map pprInstInFull stack) -\end{code} diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index 880d957718..a6b2a10aa6 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -72,6 +72,7 @@ import Pair import Unique import Data.Maybe import BasicTypes +import DynFlags import Panic import FastString import Control.Monad ( when ) @@ -1106,7 +1107,7 @@ tcLookupTh name else do -- It's imported { (eps,hpt) <- getEpsAndHpt - ; dflags <- getDOpts + ; dflags <- getDynFlags ; case lookupType dflags hpt (eps_PTE eps) name of Just thing -> return (AGlobal thing) Nothing -> do { thing <- tcImportDecl name diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 2e0e45bdc9..2c28655ccf 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1364,17 +1364,10 @@ checkValidClass cls -- Check the associated type defaults are well-formed and instantiated -- See Note [Checking consistent instantiation] - ; mapM_ check_at_defs at_stuff - - -- Check that if the class has generic methods, then the - -- class has only one parameter. We can't do generic - -- multi-parameter type classes! - ; checkTc (unary || no_generics) (genericMultiParamErr cls) - } + ; mapM_ check_at_defs at_stuff } where (tyvars, fundeps, theta, _, at_stuff, op_stuff) = classExtraBigSig cls - unary = isSingleton (snd (splitKiTyVars tyvars)) -- IA0_NOTE: only count type arguments - no_generics = null [() | (_, (GenDefMeth _)) <- op_stuff] + unary = isSingleton (snd (splitKiTyVars tyvars)) -- IA0_NOTE: only count type arguments check_op constrained_class_methods (sel_id, dm) = addErrCtxt (classOpCtxt sel_id tau) $ do @@ -1699,11 +1692,6 @@ noClassTyVarErr clas op ptext (sLit "mentions none of the type variables of the class") <+> ppr clas <+> hsep (map ppr (classTyVars clas))] -genericMultiParamErr :: Class -> SDoc -genericMultiParamErr clas - = ptext (sLit "The multi-parameter class") <+> quotes (ppr clas) <+> - ptext (sLit "cannot have generic methods") - recSynErr :: [LTyClDecl Name] -> TcRn () recSynErr syn_decls = setSrcSpan (getLoc (head sorted_decls)) $ diff --git a/compiler/types/Coercion.lhs b/compiler/types/Coercion.lhs index 4c1ab4aa5f..e2308baa0d 100644 --- a/compiler/types/Coercion.lhs +++ b/compiler/types/Coercion.lhs @@ -318,8 +318,9 @@ isCoVar v = isCoVarType (varType v) isCoVarType :: Type -> Bool isCoVarType ty -- Tests for t1 ~# t2, the unboxed equality - | Just tc <- tyConAppTyCon_maybe ty = tc `hasKey` eqPrimTyConKey - | otherwise = False + = case splitTyConApp_maybe ty of + Just (tc,tys) -> tc `hasKey` eqPrimTyConKey && tys `lengthAtLeast` 2 + Nothing -> False \end{code} @@ -456,8 +457,9 @@ pprCoAxiom ax -- -- > decomposeCo 3 c = [nth 0 c, nth 1 c, nth 2 c] decomposeCo :: Arity -> Coercion -> [Coercion] -decomposeCo arity co = [mkNthCo n co | n <- [0..(arity-1)] ] - -- Remember, Nth is zero-indexed +decomposeCo arity co + = [mkNthCo n co | n <- [0..(arity-1)] ] + -- Remember, Nth is zero-indexed -- | Attempts to obtain the type variable underlying a 'Coercion' getCoVar_maybe :: Coercion -> Maybe CoVar @@ -615,8 +617,17 @@ mkTransCo co (Refl _) = co mkTransCo co1 co2 = TransCo co1 co2 mkNthCo :: Int -> Coercion -> Coercion -mkNthCo n (Refl ty) = Refl (tyConAppArgN n ty) -mkNthCo n co = NthCo n co +mkNthCo n (Refl ty) = ASSERT( ok_tc_app ty n ) + Refl (tyConAppArgN n ty) +mkNthCo n co = ASSERT( ok_tc_app _ty1 n && ok_tc_app _ty2 n ) + NthCo n co + where + Pair _ty1 _ty2 = coercionKind co + +ok_tc_app :: Type -> Int -> Bool +ok_tc_app ty n = case splitTyConApp_maybe ty of + Just (_, tys) -> tys `lengthExceeds` n + Nothing -> False -- | Instantiates a 'Coercion' with a 'Type' argument. mkInstCo :: Coercion -> Type -> Coercion diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index bfddf5b322..feb4be50c1 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -76,6 +76,7 @@ import Foreign import Data.Array import Data.IORef import Data.Char ( ord, chr ) +import Data.Time import Data.Typeable #if __GLASGOW_HASKELL__ >= 701 import Data.Typeable.Internal @@ -488,6 +489,23 @@ instance (Binary a, Binary b) => Binary (Either a b) where 0 -> do a <- get bh ; return (Left a) _ -> do b <- get bh ; return (Right b) +instance Binary UTCTime where + put_ bh u = do put_ bh (utctDay u) + put_ bh (utctDayTime u) + get bh = do day <- get bh + dayTime <- get bh + return $ UTCTime { utctDay = day, utctDayTime = dayTime } + +instance Binary Day where + put_ bh d = put_ bh (toModifiedJulianDay d) + get bh = do i <- get bh + return $ ModifiedJulianDay { toModifiedJulianDay = i } + +instance Binary DiffTime where + put_ bh dt = put_ bh (toRational dt) + get bh = do r <- get bh + return $ fromRational r + #if defined(__GLASGOW_HASKELL__) || 1 --to quote binary-0.3 on this code idea, -- diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index c029e4a8e0..ee7e616305 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -30,6 +30,7 @@ module IOEnv ( atomicUpdMutVar, atomicUpdMutVar' ) where +import DynFlags import Exception import Panic @@ -88,6 +89,10 @@ instance Show IOEnvFailure where instance Exception IOEnvFailure +instance ContainsDynFlags env => HasDynFlags (IOEnv env) where + getDynFlags = do env <- getEnv + return $ extractDynFlags env + ---------------------------------------------------------------------- -- Fundmantal combinators specific to the monad ---------------------------------------------------------------------- diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 93800b0399..d09a1ad345 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -76,6 +76,7 @@ module Util ( -- * IO-ish utilities createDirectoryHierarchy, doesDirNameExist, + getModificationUTCTime, modificationTimeIfExists, global, consIORef, globalM, @@ -113,7 +114,6 @@ import System.IO.Error as IO ( isDoesNotExistError ) import System.Directory ( doesDirectoryExist, createDirectory, getModificationTime ) import System.FilePath -import System.Time ( ClockTime ) import Data.Char ( isUpper, isAlphaNum, isSpace, chr, ord, isDigit ) import Data.Ratio ( (%) ) @@ -122,6 +122,12 @@ import Data.Bits import Data.Word import qualified Data.IntMap as IM +import Data.Time +#if __GLASGOW_HASKELL__ < 705 +import Data.Time.Clock.POSIX +import System.Time +#endif + infixr 9 `thenCmp` \end{code} @@ -753,7 +759,7 @@ restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2 else restrictedDamerauLevenshteinDistance' (undefined :: Integer) n m str2 str1 restrictedDamerauLevenshteinDistance' - :: (Bits bv) => bv -> Int -> Int -> String -> String -> Int + :: (Bits bv, Num bv) => bv -> Int -> Int -> String -> String -> Int restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 | [] <- str1 = n | otherwise = extractAnswer $ @@ -766,7 +772,7 @@ restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 extractAnswer (_, _, _, _, distance) = distance restrictedDamerauLevenshteinDistanceWorker - :: (Bits bv) => IM.IntMap bv -> bv -> bv + :: (Bits bv, Num bv) => IM.IntMap bv -> bv -> bv -> (bv, bv, bv, bv, Int) -> Char -> (bv, bv, bv, bv, Int) restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask (pm, d0, vp, vn, distance) char2 @@ -795,7 +801,7 @@ restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask sizedComplement :: Bits bv => bv -> bv -> bv sizedComplement vector_mask vect = vector_mask `xor` vect -matchVectors :: Bits bv => String -> IM.IntMap bv +matchVectors :: (Bits bv, Num bv) => String -> IM.IntMap bv matchVectors = snd . foldl' go (0 :: Int, IM.empty) where go (ix, im) char = let ix' = ix + 1 @@ -1029,12 +1035,24 @@ doesDirNameExist fpath = case takeDirectory fpath of "" -> return True -- XXX Hack _ -> doesDirectoryExist (takeDirectory fpath) +----------------------------------------------------------------------------- +-- Backwards compatibility definition of getModificationTime + +getModificationUTCTime :: FilePath -> IO UTCTime +#if __GLASGOW_HASKELL__ < 705 +getModificationUTCTime f = do + TOD secs _ <- getModificationTime f + return $ posixSecondsToUTCTime (realToFrac secs) +#else +getModificationUTCTime = getModificationTime +#endif + -- -------------------------------------------------------------- -- check existence & modification time at the same time -modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime) +modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime) modificationTimeIfExists f = do - (do t <- getModificationTime f; return (Just t)) + (do t <- getModificationUTCTime f; return (Just t)) `catchIO` \e -> if isDoesNotExistError e then return Nothing else ioError e diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs index a6bf6d973f..426682cea8 100644 --- a/compiler/vectorise/Vectorise/Monad.hs +++ b/compiler/vectorise/Vectorise/Monad.hs @@ -54,12 +54,12 @@ initV :: HscEnv -> VM a -> IO (Maybe (VectInfo, a)) initV hsc_env guts info thing_inside - = do { - let type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) + = do { dumpIfVtTrace "Incoming VectInfo" (ppr info) + + ; let type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) ; (_, Just res) <- initDs hsc_env (mg_module guts) (mg_rdr_env guts) type_env go - ; dumpIfVtTrace "Incoming VectInfo" (ppr info) ; case res of Nothing -> dumpIfVtTrace "Vectorisation FAILED!" empty diff --git a/compiler/vectorise/Vectorise/Type/Classify.hs b/compiler/vectorise/Vectorise/Type/Classify.hs index 559bbac1b6..0cab706cf4 100644 --- a/compiler/vectorise/Vectorise/Type/Classify.hs +++ b/compiler/vectorise/Vectorise/Type/Classify.hs @@ -23,6 +23,7 @@ import DataCon import TyCon import TypeRep import Type +import PrelNames import Digraph @@ -54,14 +55,21 @@ classifyTyCons convStatus tcs = classify [] [] [] convStatus (tyConGroups tcs) where refs = ds `delListFromUniqSet` tcs - can_convert = isNullUFM (refs `minusUFM` cs) && all convertable tcs + can_convert = (isNullUFM (refs `minusUFM` cs) && all convertable tcs) + || isShowClass tcs must_convert = foldUFM (||) False (intersectUFM_C const cs refs) + && (not . isShowClass $ tcs) -- We currently admit Haskell 2011-style data and newtype declarations as well as type -- constructors representing classes. convertable tc = (isDataTyCon tc || isNewTyCon tc) && all isVanillaDataCon (tyConDataCons tc) || isClassTyCon tc + + -- !!!FIXME: currently we allow 'Show' in vectorised code without actually providing a + -- vectorised definition (to be able to vectorise 'Num') + isShowClass [tc] = tyConName tc == showClassName + isShowClass _ = False -- Used to group type constructors into mutually dependent groups. -- diff --git a/compiler/vectorise/Vectorise/Type/Env.hs b/compiler/vectorise/Vectorise/Type/Env.hs index a6f77bb9db..0051d072a4 100644 --- a/compiler/vectorise/Vectorise/Type/Env.hs +++ b/compiler/vectorise/Vectorise/Type/Env.hs @@ -147,14 +147,6 @@ vectTypeEnv :: [TyCon] -- Type constructors defined in this mod vectTypeEnv tycons vectTypeDecls vectClassDecls = do { traceVt "** vectTypeEnv" $ ppr tycons - -- Build a map containing all vectorised type constructor. If they are scalar, they are - -- mapped to 'False' (vectorised type constructor == original type constructor). - ; allScalarTyConNames <- globalScalarTyCons -- covers both current and imported modules - ; vectTyCons <- globalVectTyCons - ; let vectTyConBase = mapNameEnv (const True) vectTyCons -- by default fully vectorised - vectTyConFlavour = foldNameSet (\n env -> extendNameEnv env n False) vectTyConBase - allScalarTyConNames - ; let -- {-# VECTORISE SCALAR type T -#} (imported and local tycons) localAbstractTyCons = [tycon | VectType True tycon Nothing <- vectTypeDecls] @@ -172,6 +164,23 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls localAbstractTyCons ++ map fst3 vectTyConsWithRHS notVectSpecialTyCon tc = not $ (tyConName tc) `elemNameSet` vectSpecialTyConNames + -- Build a map containing all vectorised type constructor. If they are scalar, they are + -- mapped to 'False' (vectorised type constructor == original type constructor). + ; allScalarTyConNames <- globalScalarTyCons -- covers both current and imported modules + ; vectTyCons <- globalVectTyCons + ; let vectTyConBase = mapNameEnv (const True) vectTyCons -- by default fully vectorised + vectTyConFlavour = vectTyConBase + `plusNameEnv` + mkNameEnv [ (tyConName tycon, True) + | (tycon, _, _) <- vectTyConsWithRHS] + `plusNameEnv` + mkNameEnv [ (tcName, False) -- original representation + | tcName <- nameSetToList allScalarTyConNames] + `plusNameEnv` + mkNameEnv [ (tyConName tycon, False) -- original representation + | tycon <- localAbstractTyCons] + + -- Split the list of 'TyCons' into the ones (1) that we must vectorise and those (2) -- that we could, but don't need to vectorise. Type constructors that are not data -- type constructors or use non-Haskell98 features are being dropped. They may not @@ -219,6 +228,12 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls -- Vectorise all the data type declarations that we can and must vectorise (enter the -- type and data constructors into the vectorisation map on-the-fly.) ; new_tcs <- vectTyConDecls conv_tcs + + ; let dumpTc tc vTc = traceVt "---" (ppr tc <+> text "::" <+> ppr (dataConSig tc) $$ + ppr vTc <+> text "::" <+> ppr (dataConSig vTc)) + dataConSig tc | Just dc <- tyConSingleDataCon_maybe tc = dataConRepType dc + | otherwise = panic "dataConSig" + ; zipWithM_ dumpTc (filter isClassTyCon conv_tcs) (filter isClassTyCon new_tcs) -- We don't need new representation types for dictionary constructors. The constructors -- are always fully applied, and we don't need to lift them to arrays as a dictionary diff --git a/configure.ac b/configure.ac index 252f077303..bf7e84895a 100644 --- a/configure.ac +++ b/configure.ac @@ -466,8 +466,6 @@ dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- FPTOOLS_SET_HASKELL_PLATFORM_VARS -FP_SETTINGS - dnl ** figure out how to do context diffs FP_PROG_CONTEXT_DIFF @@ -487,6 +485,7 @@ FP_PROG_AR_NEEDS_RANLIB dnl ** Check to see whether ln -s works AC_PROG_LN_S +FP_SETTINGS dnl ** Find the path to sed AC_PATH_PROGS(SedCmd,gsed sed,sed) diff --git a/distrib/configure.ac.in b/distrib/configure.ac.in index 458f5f433f..0037ff1ce8 100644 --- a/distrib/configure.ac.in +++ b/distrib/configure.ac.in @@ -88,8 +88,6 @@ dnl May need to use gcc to find platform details. dnl -------------------------------------------------------------- FPTOOLS_SET_HASKELL_PLATFORM_VARS -FP_SETTINGS - dnl WordSize for settings.in AC_CHECK_SIZEOF(void *, 4) WordSize=$ac_cv_sizeof_void_p @@ -100,6 +98,8 @@ dnl ** how to invoke `ar' and `ranlib' # FP_PROG_AR_NEEDS_RANLIB +FP_SETTINGS + # AC_CONFIG_FILES(settings mk/config.mk mk/install.mk) AC_OUTPUT diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 12ef9460da..c2abe45e73 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -150,6 +150,98 @@ main = do args <- getArgs <variablelist> <varlistentry> + <term>Num superclasses</term> + <listitem> + <para> + The <literal>Num</literal> class does not have + <literal>Show</literal> or <literal>Eq</literal> + superclasses. + </para> + + <para> + You can make code that works with both + Haskell98/Haskell2010 and GHC by: + <itemizedlist> + <listitem> + <para> + Whenever you make a <literal>Num</literal> instance + of a type, also make <literal>Show</literal> and + <literal>Eq</literal> instances, and + </para> + </listitem> + <listitem> + <para> + Whenever you give a function, instance or class a + <literal>Num t</literal> constraint, also give it + <literal>Show t</literal> and + <literal>Eq t</literal> constraints. + </para> + </listitem> + </itemizedlist> + </para> + </listitem> + </varlistentry> + + <varlistentry> + <term>Bits superclasses</term> + <listitem> + <para> + The <literal>Bits</literal> class does not have + a <literal>Num</literal> superclasses. It therefore + does not have default methods for the + <literal>bit</literal>, + <literal>testBit</literal> and + <literal>popCount</literal> methods. + </para> + + <para> + You can make code that works with both + Haskell2010 and GHC by: + <itemizedlist> + <listitem> + <para> + Whenever you make a <literal>Bits</literal> instance + of a type, also make a <literal>Num</literal> + instance, and + </para> + </listitem> + <listitem> + <para> + Whenever you give a function, instance or class a + <literal>Bits t</literal> constraint, also give it + a <literal>Num t</literal> constraint, and + </para> + </listitem> + <listitem> + <para> + Always define the <literal>bit</literal>, + <literal>testBit</literal> and + <literal>popCount</literal> methods in + <literal>Bits</literal> instances. + </para> + </listitem> + </itemizedlist> + </para> + </listitem> + </varlistentry> + + <varlistentry> + <term>Extra instances</term> + <listitem> + <para> + The following extra instances are defined: + </para> +<programlisting> +instance Functor ((->) r) +instance Monad ((->) r) +instance Functor ((,) a) +instance Functor (Either a) +instance Monad (Either e) +</programlisting> + </listitem> + </varlistentry> + + <varlistentry> <term>Multiply-defined array elements—not checked:</term> <listitem> <para>This code fragment should diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index ecce941082..a4041348b1 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1,1211 +1,1211 @@ <?xml version="1.0" encoding="iso-8859-1"?> - <sect1 id="flag-reference"> - <title>Flag reference</title> +<sect1 id="flag-reference"> + <title>Flag reference</title> - <para>This section is a quick-reference for GHC's command-line + <para>This section is a quick-reference for GHC's command-line flags. For each flag, we also list its static/dynamic status (see <xref linkend="static-dynamic-flags"/>), and the flag's opposite (if available).</para> - <sect2> - <title>Help and verbosity options</title> - - <para><xref linkend="options-help"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-?</option></entry> - <entry>help</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-help</option></entry> - <entry>help</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-v</option></entry> - <entry>verbose mode (equivalent to <option>-v3</option>)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-v</option><replaceable>n</replaceable></entry> - <entry>set verbosity level</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-V</option></entry> - <entry>display GHC version</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>––supported-extensions</option> or <option>––supported-languages</option></entry> - <entry>display the supported languages and language extensions</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>––info</option></entry> - <entry>display information about the compiler</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>––version</option></entry> - <entry>display GHC version</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>––numeric-version</option></entry> - <entry>display GHC version (numeric only)</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>––print-libdir</option></entry> - <entry>display GHC library directory</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ferror-spans</option></entry> - <entry>output full span in error messages</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-H</option><replaceable>size</replaceable></entry> - <entry>Set the minimum heap size to <replaceable>size</replaceable></entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-Rghc-timing</option></entry> - <entry>Summarise timing stats for GHC (same as <literal>+RTS -tstderr</literal>)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - - </sect2> - <sect2> - <title>Which phases to run</title> - - <para><xref linkend="options-order"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-E</option></entry> - <entry>Stop after preprocessing (<literal>.hspp</literal> file)</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-C</option></entry> - <entry>Stop after generating C (<literal>.hc</literal> file)</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-S</option></entry> - <entry>Stop after generating assembly (<literal>.s</literal> file)</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-c</option></entry> - <entry>Do not link</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-x</option> <replaceable>suffix</replaceable></entry> - <entry>Override default behaviour for source files</entry> - <entry>static</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Alternative modes of operation</title> - - <para><xref linkend="modes"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>--interactive</option></entry> - <entry>Interactive mode - normally used by just running <command>ghci</command>; - see <xref linkend="ghci"/> for details.</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>--make</option></entry> - <entry>Build a multi-module Haskell program, automatically figuring out dependencies. Likely to be much easier, and faster, than using <command>make</command>; - see <xref linkend="make-mode"/> for details..</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-e <replaceable>expr</replaceable></option></entry> - <entry>Evaluate <replaceable>expr</replaceable>; - see <xref linkend="eval-mode"/> for details.</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-M</option></entry> - <entry>Generate dependency information suitable for use in a <filename>Makefile</filename>; - see <xref linkend="makefile-dependencies"/> for details.</entry> - <entry>mode</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Redirecting output</title> - - <para><xref linkend="options-output"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-hcsuf</option> <replaceable>suffix</replaceable></entry> - <entry>set the suffix to use for intermediate C files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-hidir</option> <replaceable>dir</replaceable></entry> - <entry>set directory for interface files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-hisuf</option> <replaceable>suffix</replaceable></entry> - <entry>set the suffix to use for interface files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-o</option> <replaceable>filename</replaceable></entry> - <entry>set output filename</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-odir</option> <replaceable>dir</replaceable></entry> - <entry>set directory for object files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ohi</option> <replaceable>filename</replaceable></entry> - <entry>set the filename in which to put the interface</entry> - <entry>dynamic</entry> - <entry></entry> - </row> - <row> - <entry><option>-osuf</option> <replaceable>suffix</replaceable></entry> - <entry>set the output file suffix</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-stubdir</option> <replaceable>dir</replaceable></entry> - <entry>redirect FFI stub files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dumpdir</option> <replaceable>dir</replaceable></entry> - <entry>redirect dump files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-outputdir</option> <replaceable>dir</replaceable></entry> - <entry>set output directory</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Keeping intermediate files</title> - - <para><xref linkend="keeping-intermediates"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-keep-hc-file</option> or - <option>-keep-hc-files</option></entry> - <entry>retain intermediate <literal>.hc</literal> files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-keep-llvm-file</option> or - <option>-keep-llvm-files</option></entry> - <entry>retain intermediate LLVM <literal>.ll</literal> files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-keep-s-file</option> or - <option>-keep-s-files</option></entry> - <entry>retain intermediate <literal>.s</literal> files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-keep-tmp-files</option></entry> - <entry>retain all intermediate temporary files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Temporary files</title> - - <para><xref linkend="temp-files"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-tmpdir</option></entry> - <entry>set the directory for temporary files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Finding imports</title> - - <para><xref linkend="search-path"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-i</option><replaceable>dir1</replaceable>:<replaceable>dir2</replaceable>:...</entry> - <entry>add <replaceable>dir</replaceable>, - <replaceable>dir2</replaceable>, etc. to import path</entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-i</option></entry> - <entry>Empty the import directory list</entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Interface file options</title> - - <para><xref linkend="hi-options"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-ddump-hi</option></entry> - <entry>Dump the new interface to stdout</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-hi-diffs</option></entry> - <entry>Show the differences vs. the old interface</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-minimal-imports</option></entry> - <entry>Dump a minimal set of imports</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>--show-iface</option> <replaceable>file</replaceable></entry> - <entry>See <xref linkend="modes"/>.</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Recompilation checking</title> - - <para><xref linkend="recomp"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fforce-recomp</option></entry> - <entry>Turn off recompilation checking; implied by any - <option>-ddump-X</option> option</entry> - <entry>dynamic</entry> - <entry><option>-fno-force-recomp</option></entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2 id="interactive-mode-options"> - <title>Interactive-mode options</title> - - <para><xref linkend="ghci-dot-files"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-ignore-dot-ghci</option></entry> - <entry>Disable reading of <filename>.ghci</filename> files</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ghci-script</option></entry> - <entry>Load the given additional <filename>.ghci</filename> file</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-read-dot-ghci</option></entry> - <entry>Enable reading of <filename>.ghci</filename> files</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fbreak-on-exception</option></entry> - <entry><link linkend="ghci-debugger-exceptions">Break on any exception thrown</link></entry> - <entry>dynamic</entry> - <entry><option>-fno-break-on-exception</option></entry> - </row> - <row> - <entry><option>-fbreak-on-error</option></entry> - <entry><link linkend="ghci-debugger-exceptions">Break on uncaught exceptions and errors</link></entry> - <entry>dynamic</entry> - <entry><option>-fno-break-on-error</option></entry> - </row> - <row> - <entry><option>-fprint-evld-with-show</option></entry> - <entry><link linkend="breakpoints">Enable usage of Show instances in <literal>:print</literal></link></entry> - <entry>dynamic</entry> - <entry><option>-fno-print-evld-with-show</option></entry> - </row> - <row> - <entry><option>-fprint-bind-result</option></entry> - <entry><link linkend="ghci-stmts">Turn on printing of binding results in GHCi</link></entry> - <entry>dynamic</entry> - <entry><option>-fno-print-bind-result</option></entry> - </row> - <row> - <entry><option>-fno-print-bind-contents</option></entry> - <entry><link linkend="breakpoints">Turn off printing of binding contents in GHCi</link></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-implicit-import-qualified</option></entry> - <entry><link linkend="ghci-import-qualified">Turn off - implicit qualified import of everything in GHCi</link></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Packages</title> - - <para><xref linkend="packages"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-package-name</option> <replaceable>P</replaceable></entry> - <entry>Compile to be part of package <replaceable>P</replaceable></entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-package</option> <replaceable>P</replaceable></entry> - <entry>Expose package <replaceable>P</replaceable></entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-hide-all-packages</option></entry> - <entry>Hide all packages by default</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-hide-package</option> <replaceable>name</replaceable></entry> - <entry>Hide package <replaceable>P</replaceable></entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ignore-package</option> <replaceable>name</replaceable></entry> - <entry>Ignore package <replaceable>P</replaceable></entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-package-conf</option> <replaceable>file</replaceable></entry> - <entry>Load more packages from <replaceable>file</replaceable></entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-no-user-package-conf</option></entry> - <entry>Don't load the user's package config file.</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-no-auto-link-packages</option></entry> - <entry>Don't automatically link in the haskell98 package.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-trust</option> <replaceable>P</replaceable></entry> - <entry>Expose package <replaceable>P</replaceable> and set it to be - trusted</entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-distrust</option> <replaceable>P</replaceable></entry> - <entry>Expose package <replaceable>P</replaceable> and set it to be - distrusted</entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - <row> - <entry><option>-distrust-all</option> </entry> - <entry>Distrust all packages by default</entry> - <entry>static/<literal>:set</literal></entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Language options</title> - - <para>Language options can be enabled either by a command-line option + <sect2> + <title>Help and verbosity options</title> + + <para><xref linkend="options-help"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-?</option></entry> + <entry>help</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-help</option></entry> + <entry>help</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-v</option></entry> + <entry>verbose mode (equivalent to <option>-v3</option>)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-v</option><replaceable>n</replaceable></entry> + <entry>set verbosity level</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-V</option></entry> + <entry>display GHC version</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>––supported-extensions</option> or <option>––supported-languages</option></entry> + <entry>display the supported languages and language extensions</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>––info</option></entry> + <entry>display information about the compiler</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>––version</option></entry> + <entry>display GHC version</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>––numeric-version</option></entry> + <entry>display GHC version (numeric only)</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>––print-libdir</option></entry> + <entry>display GHC library directory</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ferror-spans</option></entry> + <entry>output full span in error messages</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-H</option><replaceable>size</replaceable></entry> + <entry>Set the minimum heap size to <replaceable>size</replaceable></entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-Rghc-timing</option></entry> + <entry>Summarise timing stats for GHC (same as <literal>+RTS -tstderr</literal>)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + + </sect2> + <sect2> + <title>Which phases to run</title> + + <para><xref linkend="options-order"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-E</option></entry> + <entry>Stop after preprocessing (<literal>.hspp</literal> file)</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-C</option></entry> + <entry>Stop after generating C (<literal>.hc</literal> file)</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-S</option></entry> + <entry>Stop after generating assembly (<literal>.s</literal> file)</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-c</option></entry> + <entry>Do not link</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-x</option> <replaceable>suffix</replaceable></entry> + <entry>Override default behaviour for source files</entry> + <entry>static</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Alternative modes of operation</title> + + <para><xref linkend="modes"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>--interactive</option></entry> + <entry>Interactive mode - normally used by just running <command>ghci</command>; + see <xref linkend="ghci"/> for details.</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>--make</option></entry> + <entry>Build a multi-module Haskell program, automatically figuring out dependencies. Likely to be much easier, and faster, than using <command>make</command>; + see <xref linkend="make-mode"/> for details..</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-e <replaceable>expr</replaceable></option></entry> + <entry>Evaluate <replaceable>expr</replaceable>; + see <xref linkend="eval-mode"/> for details.</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-M</option></entry> + <entry>Generate dependency information suitable for use in a <filename>Makefile</filename>; + see <xref linkend="makefile-dependencies"/> for details.</entry> + <entry>mode</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Redirecting output</title> + + <para><xref linkend="options-output"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-hcsuf</option> <replaceable>suffix</replaceable></entry> + <entry>set the suffix to use for intermediate C files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-hidir</option> <replaceable>dir</replaceable></entry> + <entry>set directory for interface files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-hisuf</option> <replaceable>suffix</replaceable></entry> + <entry>set the suffix to use for interface files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-o</option> <replaceable>filename</replaceable></entry> + <entry>set output filename</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-odir</option> <replaceable>dir</replaceable></entry> + <entry>set directory for object files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ohi</option> <replaceable>filename</replaceable></entry> + <entry>set the filename in which to put the interface</entry> + <entry>dynamic</entry> + <entry></entry> + </row> + <row> + <entry><option>-osuf</option> <replaceable>suffix</replaceable></entry> + <entry>set the output file suffix</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-stubdir</option> <replaceable>dir</replaceable></entry> + <entry>redirect FFI stub files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dumpdir</option> <replaceable>dir</replaceable></entry> + <entry>redirect dump files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-outputdir</option> <replaceable>dir</replaceable></entry> + <entry>set output directory</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Keeping intermediate files</title> + + <para><xref linkend="keeping-intermediates"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-keep-hc-file</option> or + <option>-keep-hc-files</option></entry> + <entry>retain intermediate <literal>.hc</literal> files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-keep-llvm-file</option> or + <option>-keep-llvm-files</option></entry> + <entry>retain intermediate LLVM <literal>.ll</literal> files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-keep-s-file</option> or + <option>-keep-s-files</option></entry> + <entry>retain intermediate <literal>.s</literal> files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-keep-tmp-files</option></entry> + <entry>retain all intermediate temporary files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Temporary files</title> + + <para><xref linkend="temp-files"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-tmpdir</option></entry> + <entry>set the directory for temporary files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Finding imports</title> + + <para><xref linkend="search-path"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-i</option><replaceable>dir1</replaceable>:<replaceable>dir2</replaceable>:...</entry> + <entry>add <replaceable>dir</replaceable>, + <replaceable>dir2</replaceable>, etc. to import path</entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-i</option></entry> + <entry>Empty the import directory list</entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Interface file options</title> + + <para><xref linkend="hi-options"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-ddump-hi</option></entry> + <entry>Dump the new interface to stdout</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-hi-diffs</option></entry> + <entry>Show the differences vs. the old interface</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-minimal-imports</option></entry> + <entry>Dump a minimal set of imports</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>--show-iface</option> <replaceable>file</replaceable></entry> + <entry>See <xref linkend="modes"/>.</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Recompilation checking</title> + + <para><xref linkend="recomp"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fforce-recomp</option></entry> + <entry>Turn off recompilation checking; implied by any + <option>-ddump-X</option> option</entry> + <entry>dynamic</entry> + <entry><option>-fno-force-recomp</option></entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2 id="interactive-mode-options"> + <title>Interactive-mode options</title> + + <para><xref linkend="ghci-dot-files"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-ignore-dot-ghci</option></entry> + <entry>Disable reading of <filename>.ghci</filename> files</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ghci-script</option></entry> + <entry>Load the given additional <filename>.ghci</filename> file</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-read-dot-ghci</option></entry> + <entry>Enable reading of <filename>.ghci</filename> files</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fbreak-on-exception</option></entry> + <entry><link linkend="ghci-debugger-exceptions">Break on any exception thrown</link></entry> + <entry>dynamic</entry> + <entry><option>-fno-break-on-exception</option></entry> + </row> + <row> + <entry><option>-fbreak-on-error</option></entry> + <entry><link linkend="ghci-debugger-exceptions">Break on uncaught exceptions and errors</link></entry> + <entry>dynamic</entry> + <entry><option>-fno-break-on-error</option></entry> + </row> + <row> + <entry><option>-fprint-evld-with-show</option></entry> + <entry><link linkend="breakpoints">Enable usage of Show instances in <literal>:print</literal></link></entry> + <entry>dynamic</entry> + <entry><option>-fno-print-evld-with-show</option></entry> + </row> + <row> + <entry><option>-fprint-bind-result</option></entry> + <entry><link linkend="ghci-stmts">Turn on printing of binding results in GHCi</link></entry> + <entry>dynamic</entry> + <entry><option>-fno-print-bind-result</option></entry> + </row> + <row> + <entry><option>-fno-print-bind-contents</option></entry> + <entry><link linkend="breakpoints">Turn off printing of binding contents in GHCi</link></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-implicit-import-qualified</option></entry> + <entry><link linkend="ghci-import-qualified">Turn off + implicit qualified import of everything in GHCi</link></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Packages</title> + + <para><xref linkend="packages"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-package-name</option> <replaceable>P</replaceable></entry> + <entry>Compile to be part of package <replaceable>P</replaceable></entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-package</option> <replaceable>P</replaceable></entry> + <entry>Expose package <replaceable>P</replaceable></entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-hide-all-packages</option></entry> + <entry>Hide all packages by default</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-hide-package</option> <replaceable>name</replaceable></entry> + <entry>Hide package <replaceable>P</replaceable></entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ignore-package</option> <replaceable>name</replaceable></entry> + <entry>Ignore package <replaceable>P</replaceable></entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-package-conf</option> <replaceable>file</replaceable></entry> + <entry>Load more packages from <replaceable>file</replaceable></entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-no-user-package-conf</option></entry> + <entry>Don't load the user's package config file.</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-no-auto-link-packages</option></entry> + <entry>Don't automatically link in the haskell98 package.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-trust</option> <replaceable>P</replaceable></entry> + <entry>Expose package <replaceable>P</replaceable> and set it to be + trusted</entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-distrust</option> <replaceable>P</replaceable></entry> + <entry>Expose package <replaceable>P</replaceable> and set it to be + distrusted</entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + <row> + <entry><option>-distrust-all</option> </entry> + <entry>Distrust all packages by default</entry> + <entry>static/<literal>:set</literal></entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Language options</title> + + <para>Language options can be enabled either by a command-line option <option>-Xblah</option>, or by a <literal>{-# LANGUAGE blah #-}</literal> pragma in the file itself. See <xref linkend="options-language"/></para> - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fglasgow-exts</option></entry> - <entry>Enable most language extensions; see <xref linkend="options-language"/> for exactly which ones.</entry> - <entry>dynamic</entry> - <entry><option>-fno-glasgow-exts</option></entry> - </row> - <row> - <entry><option>-XOverlappingInstances</option></entry> - <entry>Enable <link linkend="instance-overlap">overlapping instances</link></entry> - <entry>dynamic</entry> - <entry><option>-XNoOverlappingInstances</option></entry> - </row> - <row> - <entry><option>-XIncoherentInstances</option></entry> - <entry>Enable <link linkend="instance-overlap">incoherent instances</link>. - Implies <option>-XOverlappingInstances</option> </entry> - <entry>dynamic</entry> - <entry><option>-XNoIncoherentInstances</option></entry> - </row> - <row> - <entry><option>-XUndecidableInstances</option></entry> - <entry>Enable <link linkend="undecidable-instances">undecidable instances</link></entry> - <entry>dynamic</entry> - <entry><option>-XNoUndecidableInstances</option></entry> - </row> - <row> - <entry><option>-fcontext-stack=N</option><replaceable>n</replaceable></entry> - <entry>set the <link linkend="undecidable-instances">limit for context reduction</link>. Default is 20.</entry> - <entry>dynamic</entry> - <entry></entry> - </row> - <row> - <entry><option>-XArrows</option></entry> - <entry>Enable <link linkend="arrow-notation">arrow - notation</link> extension</entry> - <entry>dynamic</entry> - <entry><option>-XNoArrows</option></entry> - </row> - <row> - <entry><option>-XDisambiguateRecordFields</option></entry> - <entry>Enable <link linkend="disambiguate-fields">record - field disambiguation</link></entry> - <entry>dynamic</entry> - <entry><option>-XNoDisambiguateRecordFields</option></entry> - </row> - <row> - <entry><option>-XForeignFunctionInterface</option></entry> - <entry>Enable <link linkend="ffi">foreign function interface</link> (implied by - <option>-fglasgow-exts</option>)</entry> - <entry>dynamic</entry> - <entry><option>-XNoForeignFunctionInterface</option></entry> - </row> - <row> - <entry><option>-XGenerics</option></entry> - <entry>Deprecated, does nothing. No longer enables <link linkend="generic-classes">generic classes</link>. - See also GHC's support for - <link linkend="generic-programming">generic programming</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoGenerics</option></entry> - </row> - <row> - <entry><option>-XImplicitParams</option></entry> - <entry>Enable <link linkend="implicit-parameters">Implicit Parameters</link>. - Implied by <option>-fglasgow-exts</option>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoImplicitParams</option></entry> - </row> - <row> - <entry><option>-firrefutable-tuples</option></entry> - <entry>Make tuple pattern matching irrefutable</entry> - <entry>dynamic</entry> - <entry><option>-fno-irrefutable-tuples</option></entry> - </row> - <row> - <entry><option>-XNoImplicitPrelude</option></entry> - <entry>Don't implicitly <literal>import Prelude</literal></entry> - <entry>dynamic</entry> - <entry><option>-XImplicitPrelude</option></entry> - </row> - <row> - <entry><option>-XRebindableSyntax</option></entry> - <entry>Employ <link linkend="rebindable-syntax">rebindable syntax</link></entry> - <entry>dynamic</entry> - <entry><option>-XNoRebindableSyntax</option></entry> - </row> - <row> - <entry><option>-XNoMonomorphismRestriction</option></entry> - <entry>Disable the <link linkend="monomorphism">monomorphism restriction</link></entry> - <entry>dynamic</entry> - <entry><option>-XMonomorphismRrestriction</option></entry> - </row> - <row> - <entry><option>-XNoNPlusKPatterns</option></entry> - <entry>Disable support for <literal>n+k</literal> patterns</entry> - <entry>dynamic</entry> - <entry><option>-XNPlusKPatterns</option></entry> - </row> - <row> - <entry><option>-XNoTraditionalRecordSyntax</option></entry> - <entry>Disable support for traditional record syntax (as supported by Haskell 98) <literal>C {f = x}</literal></entry> - <entry>dynamic</entry> - <entry><option>-XTraditionalRecordSyntax</option></entry> - </row> - <row> - <entry><option>-XNoMonoPatBinds</option></entry> - <entry>Make <link linkend="monomorphism">pattern bindings polymorphic</link></entry> - <entry>dynamic</entry> - <entry><option>-XMonoPatBinds</option></entry> - </row> - <row> - <entry><option>-XRelaxedPolyRec</option></entry> - <entry>Relaxed checking for <link linkend="typing-binds">mutually-recursive polymorphic functions</link></entry> - <entry>dynamic</entry> - <entry><option>-XNoRelaxedPolyRec</option></entry> - </row> - <row> - <entry><option>-XExtendedDefaultRules</option></entry> - <entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module</entry> - <entry>dynamic</entry> - <entry><option>-XNoExtendedDefaultRules</option></entry> - </row> - <row> - <entry><option>-XOverloadedStrings</option></entry> - <entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>. - </entry> - <entry>dynamic</entry> - <entry><option>-XNoOverloadedStrings</option></entry> - </row> - <row> - <entry><option>-XGADTs</option></entry> - <entry>Enable <link linkend="gadt">generalised algebraic data types</link>. - </entry> - <entry>dynamic</entry> - <entry><option>-XNoGADTs</option></entry> - </row> - <row> - <entry><option>-XGADTSyntax</option></entry> - <entry>Enable <link linkend="gadt-style">generalised algebraic data type syntax</link>. - </entry> - <entry>dynamic</entry> - <entry><option>-XNoGADTSyntax</option></entry> - </row> - <row> - <entry><option>-XTypeFamilies</option></entry> - <entry>Enable <link linkend="type-families">type families</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoTypeFamilies</option></entry> - </row> - <row> - <entry><option>-XConstraintKinds</option></entry> - <entry>Enable a <link linkend="constraint-kind">kind of constraints</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoConstraintKinds</option></entry> - </row> - <row> - <entry><option>-XPolyKinds</option></entry> - <entry>Enable <link linkend="kind-polymorphism">kind polymorphism</link>. - Implies <option>-XKindSignatures</option>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoPolyKinds</option></entry> - </row> - <row> - <entry><option>-XScopedTypeVariables</option></entry> - <entry>Enable <link linkend="scoped-type-variables">lexically-scoped type variables</link>. - Implied by <option>-fglasgow-exts</option>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoScopedTypeVariables</option></entry> - </row> - <row> - <entry><option>-XMonoLocalBinds</option></entry> - <entry>Enable <link linkend="mono-local-binds">do not generalise local bindings</link>. - </entry> - <entry>dynamic</entry> - <entry><option>-XNoMonoLocalBinds</option></entry> - </row> - <row> - <entry><option>-XTemplateHaskell</option></entry> - <entry>Enable <link linkend="template-haskell">Template Haskell</link>. - No longer implied by <option>-fglasgow-exts</option>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoTemplateHaskell</option></entry> - </row> - <row> - <entry><option>-XQuasiQuotes</option></entry> - <entry>Enable <link linkend="th-quasiquotation">quasiquotation</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoQuasiQuotes</option></entry> - </row> - <row> - <entry><option>-XBangPatterns</option></entry> - <entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoBangPatterns</option></entry> - </row> - <row> - <entry><option>-XCPP</option></entry> - <entry>Enable the <link linkend="c-pre-processor">C preprocessor</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoCPP</option></entry> - </row> - <row> - <entry><option>-XPatternGuards</option></entry> - <entry>Enable <link linkend="pattern-guards">pattern guards</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoPatternGuards</option></entry> - </row> - <row> - <entry><option>-XViewPatterns</option></entry> - <entry>Enable <link linkend="view-patterns">view patterns</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoViewPatterns</option></entry> - </row> - <row> - <entry><option>-XUnicodeSyntax</option></entry> - <entry>Enable <link linkend="unicode-syntax">unicode syntax</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoUnicodeSyntax</option></entry> - </row> - <row> - <entry><option>-XMagicHash</option></entry> - <entry>Allow "#" as a <link linkend="magic-hash">postfix modifier on identifiers</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoMagicHash</option></entry> - </row> - <row> - <entry><option>-XExplicitForAll</option></entry> - <entry>Enable <link linkend="explicit-foralls">explicit universal quantification</link>. + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fglasgow-exts</option></entry> + <entry>Enable most language extensions; see <xref linkend="options-language"/> for exactly which ones.</entry> + <entry>dynamic</entry> + <entry><option>-fno-glasgow-exts</option></entry> + </row> + <row> + <entry><option>-XOverlappingInstances</option></entry> + <entry>Enable <link linkend="instance-overlap">overlapping instances</link></entry> + <entry>dynamic</entry> + <entry><option>-XNoOverlappingInstances</option></entry> + </row> + <row> + <entry><option>-XIncoherentInstances</option></entry> + <entry>Enable <link linkend="instance-overlap">incoherent instances</link>. + Implies <option>-XOverlappingInstances</option> </entry> + <entry>dynamic</entry> + <entry><option>-XNoIncoherentInstances</option></entry> + </row> + <row> + <entry><option>-XUndecidableInstances</option></entry> + <entry>Enable <link linkend="undecidable-instances">undecidable instances</link></entry> + <entry>dynamic</entry> + <entry><option>-XNoUndecidableInstances</option></entry> + </row> + <row> + <entry><option>-fcontext-stack=N</option><replaceable>n</replaceable></entry> + <entry>set the <link linkend="undecidable-instances">limit for context reduction</link>. Default is 20.</entry> + <entry>dynamic</entry> + <entry></entry> + </row> + <row> + <entry><option>-XArrows</option></entry> + <entry>Enable <link linkend="arrow-notation">arrow + notation</link> extension</entry> + <entry>dynamic</entry> + <entry><option>-XNoArrows</option></entry> + </row> + <row> + <entry><option>-XDisambiguateRecordFields</option></entry> + <entry>Enable <link linkend="disambiguate-fields">record + field disambiguation</link></entry> + <entry>dynamic</entry> + <entry><option>-XNoDisambiguateRecordFields</option></entry> + </row> + <row> + <entry><option>-XForeignFunctionInterface</option></entry> + <entry>Enable <link linkend="ffi">foreign function interface</link> (implied by + <option>-fglasgow-exts</option>)</entry> + <entry>dynamic</entry> + <entry><option>-XNoForeignFunctionInterface</option></entry> + </row> + <row> + <entry><option>-XGenerics</option></entry> + <entry>Deprecated, does nothing. No longer enables <link linkend="generic-classes">generic classes</link>. + See also GHC's support for + <link linkend="generic-programming">generic programming</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoGenerics</option></entry> + </row> + <row> + <entry><option>-XImplicitParams</option></entry> + <entry>Enable <link linkend="implicit-parameters">Implicit Parameters</link>. + Implied by <option>-fglasgow-exts</option>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoImplicitParams</option></entry> + </row> + <row> + <entry><option>-firrefutable-tuples</option></entry> + <entry>Make tuple pattern matching irrefutable</entry> + <entry>dynamic</entry> + <entry><option>-fno-irrefutable-tuples</option></entry> + </row> + <row> + <entry><option>-XNoImplicitPrelude</option></entry> + <entry>Don't implicitly <literal>import Prelude</literal></entry> + <entry>dynamic</entry> + <entry><option>-XImplicitPrelude</option></entry> + </row> + <row> + <entry><option>-XRebindableSyntax</option></entry> + <entry>Employ <link linkend="rebindable-syntax">rebindable syntax</link></entry> + <entry>dynamic</entry> + <entry><option>-XNoRebindableSyntax</option></entry> + </row> + <row> + <entry><option>-XNoMonomorphismRestriction</option></entry> + <entry>Disable the <link linkend="monomorphism">monomorphism restriction</link></entry> + <entry>dynamic</entry> + <entry><option>-XMonomorphismRrestriction</option></entry> + </row> + <row> + <entry><option>-XNoNPlusKPatterns</option></entry> + <entry>Disable support for <literal>n+k</literal> patterns</entry> + <entry>dynamic</entry> + <entry><option>-XNPlusKPatterns</option></entry> + </row> + <row> + <entry><option>-XNoTraditionalRecordSyntax</option></entry> + <entry>Disable support for traditional record syntax (as supported by Haskell 98) <literal>C {f = x}</literal></entry> + <entry>dynamic</entry> + <entry><option>-XTraditionalRecordSyntax</option></entry> + </row> + <row> + <entry><option>-XNoMonoPatBinds</option></entry> + <entry>Make <link linkend="monomorphism">pattern bindings polymorphic</link></entry> + <entry>dynamic</entry> + <entry><option>-XMonoPatBinds</option></entry> + </row> + <row> + <entry><option>-XRelaxedPolyRec</option></entry> + <entry>Relaxed checking for <link linkend="typing-binds">mutually-recursive polymorphic functions</link></entry> + <entry>dynamic</entry> + <entry><option>-XNoRelaxedPolyRec</option></entry> + </row> + <row> + <entry><option>-XExtendedDefaultRules</option></entry> + <entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module</entry> + <entry>dynamic</entry> + <entry><option>-XNoExtendedDefaultRules</option></entry> + </row> + <row> + <entry><option>-XOverloadedStrings</option></entry> + <entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>. + </entry> + <entry>dynamic</entry> + <entry><option>-XNoOverloadedStrings</option></entry> + </row> + <row> + <entry><option>-XGADTs</option></entry> + <entry>Enable <link linkend="gadt">generalised algebraic data types</link>. + </entry> + <entry>dynamic</entry> + <entry><option>-XNoGADTs</option></entry> + </row> + <row> + <entry><option>-XGADTSyntax</option></entry> + <entry>Enable <link linkend="gadt-style">generalised algebraic data type syntax</link>. + </entry> + <entry>dynamic</entry> + <entry><option>-XNoGADTSyntax</option></entry> + </row> + <row> + <entry><option>-XTypeFamilies</option></entry> + <entry>Enable <link linkend="type-families">type families</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoTypeFamilies</option></entry> + </row> + <row> + <entry><option>-XConstraintKinds</option></entry> + <entry>Enable a <link linkend="constraint-kind">kind of constraints</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoConstraintKinds</option></entry> + </row> + <row> + <entry><option>-XPolyKinds</option></entry> + <entry>Enable <link linkend="kind-polymorphism">kind polymorphism</link>. + Implies <option>-XKindSignatures</option>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoPolyKinds</option></entry> + </row> + <row> + <entry><option>-XScopedTypeVariables</option></entry> + <entry>Enable <link linkend="scoped-type-variables">lexically-scoped type variables</link>. + Implied by <option>-fglasgow-exts</option>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoScopedTypeVariables</option></entry> + </row> + <row> + <entry><option>-XMonoLocalBinds</option></entry> + <entry>Enable <link linkend="mono-local-binds">do not generalise local bindings</link>. + </entry> + <entry>dynamic</entry> + <entry><option>-XNoMonoLocalBinds</option></entry> + </row> + <row> + <entry><option>-XTemplateHaskell</option></entry> + <entry>Enable <link linkend="template-haskell">Template Haskell</link>. + No longer implied by <option>-fglasgow-exts</option>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoTemplateHaskell</option></entry> + </row> + <row> + <entry><option>-XQuasiQuotes</option></entry> + <entry>Enable <link linkend="th-quasiquotation">quasiquotation</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoQuasiQuotes</option></entry> + </row> + <row> + <entry><option>-XBangPatterns</option></entry> + <entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoBangPatterns</option></entry> + </row> + <row> + <entry><option>-XCPP</option></entry> + <entry>Enable the <link linkend="c-pre-processor">C preprocessor</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoCPP</option></entry> + </row> + <row> + <entry><option>-XPatternGuards</option></entry> + <entry>Enable <link linkend="pattern-guards">pattern guards</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoPatternGuards</option></entry> + </row> + <row> + <entry><option>-XViewPatterns</option></entry> + <entry>Enable <link linkend="view-patterns">view patterns</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoViewPatterns</option></entry> + </row> + <row> + <entry><option>-XUnicodeSyntax</option></entry> + <entry>Enable <link linkend="unicode-syntax">unicode syntax</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoUnicodeSyntax</option></entry> + </row> + <row> + <entry><option>-XMagicHash</option></entry> + <entry>Allow "#" as a <link linkend="magic-hash">postfix modifier on identifiers</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoMagicHash</option></entry> + </row> + <row> + <entry><option>-XExplicitForAll</option></entry> + <entry>Enable <link linkend="explicit-foralls">explicit universal quantification</link>. Implied by <option>-XScopedTypeVariables</option>, - <option>-XLiberalTypeSynonyms</option>, - <option>-XRank2Types</option>, - <option>-XRankNTypes</option>, - <option>-XPolymorphicComponents</option>, - <option>-XExistentialQuantification</option> - </entry> - <entry>dynamic</entry> - <entry><option>-XNoExplicitForAll</option></entry> - </row> - <row> - <entry><option>-XPolymorphicComponents</option></entry> - <entry>Enable <link linkend="universal-quantification">polymorphic components for data constructors</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoPolymorphicComponents</option></entry> - </row> - <row> - <entry><option>-XRank2Types</option></entry> - <entry>Enable <link linkend="universal-quantification">rank-2 types</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoRank2Types</option></entry> - </row> - <row> - <entry><option>-XRankNTypes</option></entry> - <entry>Enable <link linkend="universal-quantification">rank-N types</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoRankNTypes</option></entry> - </row> - <row> - <entry><option>-XImpredicativeTypes</option></entry> - <entry>Enable <link linkend="impredicative-polymorphism">impredicative types</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoImpredicativeTypes</option></entry> - </row> - <row> - <entry><option>-XExistentialQuantification</option></entry> - <entry>Enable <link linkend="existential-quantification">existential quantification</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoExistentialQuantification</option></entry> - </row> - <row> - <entry><option>-XKindSignatures</option></entry> - <entry>Enable <link linkend="kinding">kind signatures</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoKindSignatures</option></entry> - </row> - <row> - <entry><option>-XEmptyDataDecls</option></entry> - <entry>Enable empty data declarations.</entry> - <entry>dynamic</entry> - <entry><option>-XNoEmptyDataDecls</option></entry> - </row> - <row> - <entry><option>-XParallelListComp</option></entry> - <entry>Enable <link linkend="parallel-list-comprehensions">parallel list comprehensions</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoParallelListComp</option></entry> - </row> - <row> - <entry><option>-XTransformListComp</option></entry> - <entry>Enable <link linkend="generalised-list-comprehensions">generalised list comprehensions</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoTransformListComp</option></entry> - </row> - <row> - <entry><option>-XMonadComprehensions</option></entry> - <entry>Enable <link linkend="monad-comprehensions">monad comprehensions</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoMonadComprehensions</option></entry> - </row> - <row> - <entry><option>-XUnliftedFFITypes</option></entry> - <entry>Enable unlifted FFI types.</entry> - <entry>dynamic</entry> - <entry><option>-XNoUnliftedFFITypes</option></entry> - </row> - <row> - <entry><option>-XInterruptibleFFI</option></entry> - <entry>Enable interruptible FFI.</entry> - <entry>dynamic</entry> - <entry><option>-XNoInterruptibleFFI</option></entry> - </row> - <row> - <entry><option>-XLiberalTypeSynonyms</option></entry> - <entry>Enable <link linkend="type-synonyms">liberalised type synonyms</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoLiberalTypeSynonyms</option></entry> - </row> - <row> - <entry><option>-XTypeOperators</option></entry> - <entry>Enable type operators.</entry> - <entry>dynamic</entry> - <entry><option>-XNoTypeOperators</option></entry> - </row> - <row> - <entry><option>-XDoRec</option></entry> - <entry>Enable <link linkend="recursive-do-notation">recursive do notation</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoDoRec</option></entry> - </row> - <row> - <entry><option>-XRecursiveDo</option></entry> - <entry>Enable <link linkend="mdo-notation">recursive do (mdo) notation</link>. This is deprecated; please use <link linkend="recursive-do-notation">recursive do notation</link> instead.</entry> - <entry>dynamic</entry> - <entry><option>-XNoRecursiveDo</option></entry> - </row> - <row> - <entry><option>-XParallelArrays</option></entry> - <entry>Enable parallel arrays.</entry> - <entry>dynamic</entry> - <entry><option>-XNoParallelArrays</option></entry> - </row> - <row> - <entry><option>-XRecordWildCards</option></entry> - <entry>Enable <link linkend="record-wildcards">record wildcards</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoRecordWildCards</option></entry> - </row> - <row> - <entry><option>-XNamedFieldPuns</option></entry> - <entry>Enable <link linkend="record-puns">record puns</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoNamedFieldPuns</option></entry> - </row> - <row> - <entry><option>-XDisambiguateRecordFields</option></entry> - <entry>Enable <link linkend="disambiguate-fields">record field disambiguation</link>. </entry> - <entry>dynamic</entry> - <entry><option>-XNoDisambiguateRecordFields</option></entry> - </row> - <row> - <entry><option>-XUnboxedTuples</option></entry> - <entry>Enable <link linkend="unboxed-tuples">unboxed tuples</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoUnboxedTuples</option></entry> - </row> - <row> - <entry><option>-XStandaloneDeriving</option></entry> - <entry>Enable <link linkend="stand-alone-deriving">standalone deriving</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoStandaloneDeriving</option></entry> - </row> - <row> - <entry><option>-XDeriveDataTypeable</option></entry> - <entry>Enable <link linkend="deriving-typeable">deriving for the Data and Typeable classes</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoDeriveDataTypeable</option></entry> - </row> - <row> - <entry><option>-XDeriveGeneric</option></entry> - <entry>Enable <link linkend="deriving-typeable">deriving for the Generic class</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoDeriveGeneric</option></entry> - </row> - <row> - <entry><option>-XGeneralizedNewtypeDeriving</option></entry> - <entry>Enable <link linkend="newtype-deriving">newtype deriving</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoGeneralizedNewtypeDeriving</option></entry> - </row> - <row> - <entry><option>-XTypeSynonymInstances</option></entry> - <entry>Enable <link linkend="flexible-instance-head">type synonyms in instance heads</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoTypeSynonymInstances</option></entry> - </row> - <row> - <entry><option>-XFlexibleContexts</option></entry> - <entry>Enable <link linkend="flexible-contexts">flexible contexts</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoFlexibleContexts</option></entry> - </row> - <row> - <entry><option>-XFlexibleInstances</option></entry> - <entry>Enable <link linkend="instance-rules">flexible instances</link>. + <option>-XLiberalTypeSynonyms</option>, + <option>-XRank2Types</option>, + <option>-XRankNTypes</option>, + <option>-XPolymorphicComponents</option>, + <option>-XExistentialQuantification</option> + </entry> + <entry>dynamic</entry> + <entry><option>-XNoExplicitForAll</option></entry> + </row> + <row> + <entry><option>-XPolymorphicComponents</option></entry> + <entry>Enable <link linkend="universal-quantification">polymorphic components for data constructors</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoPolymorphicComponents</option></entry> + </row> + <row> + <entry><option>-XRank2Types</option></entry> + <entry>Enable <link linkend="universal-quantification">rank-2 types</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoRank2Types</option></entry> + </row> + <row> + <entry><option>-XRankNTypes</option></entry> + <entry>Enable <link linkend="universal-quantification">rank-N types</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoRankNTypes</option></entry> + </row> + <row> + <entry><option>-XImpredicativeTypes</option></entry> + <entry>Enable <link linkend="impredicative-polymorphism">impredicative types</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoImpredicativeTypes</option></entry> + </row> + <row> + <entry><option>-XExistentialQuantification</option></entry> + <entry>Enable <link linkend="existential-quantification">existential quantification</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoExistentialQuantification</option></entry> + </row> + <row> + <entry><option>-XKindSignatures</option></entry> + <entry>Enable <link linkend="kinding">kind signatures</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoKindSignatures</option></entry> + </row> + <row> + <entry><option>-XEmptyDataDecls</option></entry> + <entry>Enable empty data declarations.</entry> + <entry>dynamic</entry> + <entry><option>-XNoEmptyDataDecls</option></entry> + </row> + <row> + <entry><option>-XParallelListComp</option></entry> + <entry>Enable <link linkend="parallel-list-comprehensions">parallel list comprehensions</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoParallelListComp</option></entry> + </row> + <row> + <entry><option>-XTransformListComp</option></entry> + <entry>Enable <link linkend="generalised-list-comprehensions">generalised list comprehensions</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoTransformListComp</option></entry> + </row> + <row> + <entry><option>-XMonadComprehensions</option></entry> + <entry>Enable <link linkend="monad-comprehensions">monad comprehensions</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoMonadComprehensions</option></entry> + </row> + <row> + <entry><option>-XUnliftedFFITypes</option></entry> + <entry>Enable unlifted FFI types.</entry> + <entry>dynamic</entry> + <entry><option>-XNoUnliftedFFITypes</option></entry> + </row> + <row> + <entry><option>-XInterruptibleFFI</option></entry> + <entry>Enable interruptible FFI.</entry> + <entry>dynamic</entry> + <entry><option>-XNoInterruptibleFFI</option></entry> + </row> + <row> + <entry><option>-XLiberalTypeSynonyms</option></entry> + <entry>Enable <link linkend="type-synonyms">liberalised type synonyms</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoLiberalTypeSynonyms</option></entry> + </row> + <row> + <entry><option>-XTypeOperators</option></entry> + <entry>Enable type operators.</entry> + <entry>dynamic</entry> + <entry><option>-XNoTypeOperators</option></entry> + </row> + <row> + <entry><option>-XDoRec</option></entry> + <entry>Enable <link linkend="recursive-do-notation">recursive do notation</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoDoRec</option></entry> + </row> + <row> + <entry><option>-XRecursiveDo</option></entry> + <entry>Enable <link linkend="mdo-notation">recursive do (mdo) notation</link>. This is deprecated; please use <link linkend="recursive-do-notation">recursive do notation</link> instead.</entry> + <entry>dynamic</entry> + <entry><option>-XNoRecursiveDo</option></entry> + </row> + <row> + <entry><option>-XParallelArrays</option></entry> + <entry>Enable parallel arrays.</entry> + <entry>dynamic</entry> + <entry><option>-XNoParallelArrays</option></entry> + </row> + <row> + <entry><option>-XRecordWildCards</option></entry> + <entry>Enable <link linkend="record-wildcards">record wildcards</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoRecordWildCards</option></entry> + </row> + <row> + <entry><option>-XNamedFieldPuns</option></entry> + <entry>Enable <link linkend="record-puns">record puns</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoNamedFieldPuns</option></entry> + </row> + <row> + <entry><option>-XDisambiguateRecordFields</option></entry> + <entry>Enable <link linkend="disambiguate-fields">record field disambiguation</link>. </entry> + <entry>dynamic</entry> + <entry><option>-XNoDisambiguateRecordFields</option></entry> + </row> + <row> + <entry><option>-XUnboxedTuples</option></entry> + <entry>Enable <link linkend="unboxed-tuples">unboxed tuples</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoUnboxedTuples</option></entry> + </row> + <row> + <entry><option>-XStandaloneDeriving</option></entry> + <entry>Enable <link linkend="stand-alone-deriving">standalone deriving</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoStandaloneDeriving</option></entry> + </row> + <row> + <entry><option>-XDeriveDataTypeable</option></entry> + <entry>Enable <link linkend="deriving-typeable">deriving for the Data and Typeable classes</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoDeriveDataTypeable</option></entry> + </row> + <row> + <entry><option>-XDeriveGeneric</option></entry> + <entry>Enable <link linkend="deriving-typeable">deriving for the Generic class</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoDeriveGeneric</option></entry> + </row> + <row> + <entry><option>-XGeneralizedNewtypeDeriving</option></entry> + <entry>Enable <link linkend="newtype-deriving">newtype deriving</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoGeneralizedNewtypeDeriving</option></entry> + </row> + <row> + <entry><option>-XTypeSynonymInstances</option></entry> + <entry>Enable <link linkend="flexible-instance-head">type synonyms in instance heads</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoTypeSynonymInstances</option></entry> + </row> + <row> + <entry><option>-XFlexibleContexts</option></entry> + <entry>Enable <link linkend="flexible-contexts">flexible contexts</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoFlexibleContexts</option></entry> + </row> + <row> + <entry><option>-XFlexibleInstances</option></entry> + <entry>Enable <link linkend="instance-rules">flexible instances</link>. Implies <option>-XTypeSynonymInstances</option> </entry> - <entry>dynamic</entry> - <entry><option>-XNoFlexibleInstances</option></entry> - </row> - <row> - <entry><option>-XConstrainedClassMethods</option></entry> - <entry>Enable <link linkend="class-method-types">constrained class methods</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoConstrainedClassMethods</option></entry> - </row> - <row> - <entry><option>-XDefaultSignatures</option></entry> - <entry>Enable <link linkend="class-default-signatures">default signatures</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoDefaultSignatures</option></entry> - </row> - <row> - <entry><option>-XMultiParamTypeClasses</option></entry> - <entry>Enable <link linkend="multi-param-type-classes">multi parameter type classes</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoMultiParamTypeClasses</option></entry> - </row> - <row> - <entry><option>-XFunctionalDependencies</option></entry> - <entry>Enable <link linkend="functional-dependencies">functional dependencies</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoFunctionalDependencies</option></entry> - </row> - <row> - <entry><option>-XPackageImports</option></entry> - <entry>Enable <link linkend="package-imports">package-qualified imports</link>.</entry> - <entry>dynamic</entry> - <entry><option>-XNoPackageImports</option></entry> - </row> - <row> - <entry><option>-XSafe</option></entry> - <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Safe mode.</entry> - <entry>dynamic</entry> - <entry><option>-</option></entry> - </row> - <row> - <entry><option>-XTrustworthy</option></entry> - <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Trustworthy mode.</entry> - <entry>dynamic</entry> - <entry><option>-</option></entry> - </row> - <row> - <entry><option>-XUnsafe</option></entry> - <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> Unsafe mode.</entry> - <entry>dynamic</entry> - <entry><option>-</option></entry> - </row> - <row> - <entry><option>-fpackage-trust</option></entry> - <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> trusted package requirement for trustworty modules.</entry> - <entry>dynamic</entry> - <entry><option>-</option></entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Warnings</title> - - <para><xref linkend="options-sanity"/></para> + <entry>dynamic</entry> + <entry><option>-XNoFlexibleInstances</option></entry> + </row> + <row> + <entry><option>-XConstrainedClassMethods</option></entry> + <entry>Enable <link linkend="class-method-types">constrained class methods</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoConstrainedClassMethods</option></entry> + </row> + <row> + <entry><option>-XDefaultSignatures</option></entry> + <entry>Enable <link linkend="class-default-signatures">default signatures</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoDefaultSignatures</option></entry> + </row> + <row> + <entry><option>-XMultiParamTypeClasses</option></entry> + <entry>Enable <link linkend="multi-param-type-classes">multi parameter type classes</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoMultiParamTypeClasses</option></entry> + </row> + <row> + <entry><option>-XFunctionalDependencies</option></entry> + <entry>Enable <link linkend="functional-dependencies">functional dependencies</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoFunctionalDependencies</option></entry> + </row> + <row> + <entry><option>-XPackageImports</option></entry> + <entry>Enable <link linkend="package-imports">package-qualified imports</link>.</entry> + <entry>dynamic</entry> + <entry><option>-XNoPackageImports</option></entry> + </row> + <row> + <entry><option>-XSafe</option></entry> + <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Safe mode.</entry> + <entry>dynamic</entry> + <entry><option>-</option></entry> + </row> + <row> + <entry><option>-XTrustworthy</option></entry> + <entry>Enable the <link linkend="safe-haskell">Safe Haskell</link> Trustworthy mode.</entry> + <entry>dynamic</entry> + <entry><option>-</option></entry> + </row> + <row> + <entry><option>-XUnsafe</option></entry> + <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> Unsafe mode.</entry> + <entry>dynamic</entry> + <entry><option>-</option></entry> + </row> + <row> + <entry><option>-fpackage-trust</option></entry> + <entry>Enable <link linkend="safe-haskell">Safe Haskell</link> trusted package requirement for trustworty modules.</entry> + <entry>dynamic</entry> + <entry><option>-</option></entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Warnings</title> + + <para><xref linkend="options-sanity"/></para> <informaltable> <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-W</option></entry> - <entry>enable normal warnings</entry> - <entry>dynamic</entry> - <entry><option>-w</option></entry> - </row> - <row> - <entry><option>-w</option></entry> - <entry>disable all warnings</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-Wall</option></entry> - <entry>enable almost all warnings (details in <xref linkend="options-sanity"/>)</entry> - <entry>dynamic</entry> - <entry><option>-w</option></entry> - </row> - <row> - <entry><option>-Werror</option></entry> - <entry>make warnings fatal</entry> - <entry>dynamic</entry> - <entry>-Wwarn</entry> - </row> - <row> - <entry><option>-Wwarn</option></entry> - <entry>make warnings non-fatal</entry> - <entry>dynamic</entry> - <entry>-Werror</entry> - </row> - - <row> - <entry><option>-fdefer-type-errors</option></entry> - <entry>Defer as many type errors as possible until runtime.</entry> - <entry>dynamic</entry> - <entry><option>-fno-defer-type-errors</option></entry> - </row> - - <row> - <entry><option>-fhelpful-errors</option></entry> - <entry>Make suggestions for mis-spelled names.</entry> - <entry>dynamic</entry> - <entry><option>-fno-helpful-errors</option></entry> - </row> - - <row> - <entry><option>-fwarn-deprecated-flags</option></entry> - <entry>warn about uses of commandline flags that are deprecated</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-deprecated-flags</option></entry> - </row> - - <row> - <entry><option>-fwarn-duplicate-exports</option></entry> - <entry>warn when an entity is exported multiple times</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-duplicate-exports</option></entry> - </row> - - <row> - <entry><option>-fwarn-hi-shadowing</option></entry> - <entry>warn when a <literal>.hi</literal> file in the - current directory shadows a library</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-hi-shadowing</option></entry> - </row> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-W</option></entry> + <entry>enable normal warnings</entry> + <entry>dynamic</entry> + <entry><option>-w</option></entry> + </row> + <row> + <entry><option>-w</option></entry> + <entry>disable all warnings</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-Wall</option></entry> + <entry>enable almost all warnings (details in <xref linkend="options-sanity"/>)</entry> + <entry>dynamic</entry> + <entry><option>-w</option></entry> + </row> + <row> + <entry><option>-Werror</option></entry> + <entry>make warnings fatal</entry> + <entry>dynamic</entry> + <entry>-Wwarn</entry> + </row> + <row> + <entry><option>-Wwarn</option></entry> + <entry>make warnings non-fatal</entry> + <entry>dynamic</entry> + <entry>-Werror</entry> + </row> + + <row> + <entry><option>-fdefer-type-errors</option></entry> + <entry>Defer as many type errors as possible until runtime.</entry> + <entry>dynamic</entry> + <entry><option>-fno-defer-type-errors</option></entry> + </row> + + <row> + <entry><option>-fhelpful-errors</option></entry> + <entry>Make suggestions for mis-spelled names.</entry> + <entry>dynamic</entry> + <entry><option>-fno-helpful-errors</option></entry> + </row> + + <row> + <entry><option>-fwarn-deprecated-flags</option></entry> + <entry>warn about uses of commandline flags that are deprecated</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-deprecated-flags</option></entry> + </row> + + <row> + <entry><option>-fwarn-duplicate-exports</option></entry> + <entry>warn when an entity is exported multiple times</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-duplicate-exports</option></entry> + </row> + + <row> + <entry><option>-fwarn-hi-shadowing</option></entry> + <entry>warn when a <literal>.hi</literal> file in the + current directory shadows a library</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-hi-shadowing</option></entry> + </row> <row> <entry><option>-fwarn-identities</option></entry> <entry>warn about uses of Prelude numeric conversions that are probably - the identity (and hence could be omitted)</entry> + the identity (and hence could be omitted)</entry> <entry>dynamic</entry> <entry><option>-fno-warn-identities</option></entry> </row> @@ -1217,1622 +1217,1648 @@ <entry><option>-fno-warn-implicit-prelude</option></entry> </row> - <row> - <entry><option>-fwarn-incomplete-patterns</option></entry> - <entry>warn when a pattern match could fail</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-incomplete-patterns</option></entry> - </row> - - <row> - <entry><option>-fwarn-incomplete-uni-patterns</option></entry> - <entry>warn when a pattern match in a lambda expression or pattern binding could fail</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-incomplete-uni-patterns</option></entry> - </row> - - <row> - <entry><option>-fwarn-incomplete-record-updates</option></entry> - <entry>warn when a record update could fail</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-incomplete-record-updates</option></entry> - </row> - - <row> + <row> + <entry><option>-fwarn-incomplete-patterns</option></entry> + <entry>warn when a pattern match could fail</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-incomplete-patterns</option></entry> + </row> + + <row> + <entry><option>-fwarn-incomplete-uni-patterns</option></entry> + <entry>warn when a pattern match in a lambda expression or pattern binding could fail</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-incomplete-uni-patterns</option></entry> + </row> + + <row> + <entry><option>-fwarn-incomplete-record-updates</option></entry> + <entry>warn when a record update could fail</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-incomplete-record-updates</option></entry> + </row> + + <row> <entry><option>-fwarn-lazy-unlifted-bindings</option></entry> <entry>warn when a pattern binding looks lazy but must be strict</entry> - <entry>dynamic</entry> + <entry>dynamic</entry> <entry><option>-fno-warn-lazy-unlifted-bindings</option></entry> - </row> - - <row> - <entry><option>-fwarn-missing-fields</option></entry> - <entry>warn when fields of a record are uninitialised</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-missing-fields</option></entry> - </row> - - <row> - <entry><option>-fwarn-missing-import-lists</option></entry> - <entry>warn when an import declaration does not explicitly - list all the names brought into scope</entry> - <entry>dynamic</entry> - <entry><option>-fnowarn-missing-import-lists</option></entry> - </row> - - <row> - <entry><option>-fwarn-missing-methods</option></entry> - <entry>warn when class methods are undefined</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-missing-methods</option></entry> - </row> - - <row> - <entry><option>-fwarn-missing-signatures</option></entry> - <entry>warn about top-level functions without signatures</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-missing-signatures</option></entry> - </row> - - <row> - <entry><option>-fwarn-missing-local-sigs</option></entry> - <entry>warn about polymorphic local bindings without signatures</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-missing-local-sigs</option></entry> - </row> - - <row> - <entry><option>-fwarn-monomorphism-restriction</option></entry> - <entry>warn when the Monomorphism Restriction is applied</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-monomorphism-restriction</option></entry> - </row> - - <row> - <entry><option>-fwarn-name-shadowing</option></entry> - <entry>warn when names are shadowed</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-name-shadowing</option></entry> - </row> - - <row> - <entry><option>-fwarn-orphans</option></entry> - <entry>warn when the module contains <link linkend="orphan-modules">orphan instance declarations - or rewrite rules</link></entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-orphans</option></entry> - </row> - - <row> - <entry><option>-fwarn-overlapping-patterns</option></entry> - <entry>warn about overlapping patterns</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-overlapping-patterns</option></entry> - </row> - - <row> - <entry><option>-fwarn-tabs</option></entry> - <entry>warn if there are tabs in the source file</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-tabs</option></entry> - </row> - - <row> - <entry><option>-fwarn-type-defaults</option></entry> - <entry>warn when defaulting happens</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-type-defaults</option></entry> - </row> - - <row> - <entry><option>-fwarn-unrecognised-pragmas</option></entry> - <entry>warn about uses of pragmas that GHC doesn't recognise</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unrecognised-pragmas</option></entry> - </row> - - <row> - <entry><option>-fwarn-unused-binds</option></entry> - <entry>warn about bindings that are unused</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unused-binds</option></entry> - </row> - - <row> - <entry><option>-fwarn-unused-imports</option></entry> - <entry>warn about unnecessary imports</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unused-imports</option></entry> - </row> - - <row> - <entry><option>-fwarn-unused-matches</option></entry> - <entry>warn about variables in patterns that aren't used</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unused-matches</option></entry> - </row> - - <row> - <entry><option>-fwarn-unused-do-bind</option></entry> - <entry>warn about do bindings that appear to throw away values of types other than <literal>()</literal></entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unused-do-bind</option></entry> - </row> - - <row> - <entry><option>-fwarn-wrong-do-bind</option></entry> - <entry>warn about do bindings that appear to throw away monadic values that you should have bound instead</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-wrong-do-bind</option></entry> - </row> - - <row> - <entry><option>-fwarn-unsafe</option></entry> - <entry>warn if the module being compiled is regarded to be unsafe. - Should be used to check the safety status of modules when using safe - inference.</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-unsafe</option></entry> - </row> - - <row> - <entry><option>-fwarn-safe</option></entry> - <entry>warn if the module being compiled is regarded to be safe. - Should be used to check the safety status of modules when using safe - inference.</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-safe</option></entry> - </row> - - <row> - <entry><option>-fwarn-warnings-deprecations</option></entry> - <entry>warn about uses of functions & types that have warnings or deprecated pragmas</entry> - <entry>dynamic</entry> - <entry><option>-fno-warn-warnings-deprecations</option></entry> - </row> - - </tbody> - </tgroup> - </informaltable> - - </sect2> - <sect2> - <title>Optimisation levels</title> - - <para><xref linkend="options-optimise"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-O</option></entry> - <entry>Enable default optimisation (level 1)</entry> - <entry>dynamic</entry> - <entry><option>-O0</option></entry> - </row> - <row> - <entry><option>-O</option><replaceable>n</replaceable></entry> - <entry>Set optimisation level <replaceable>n</replaceable></entry> - <entry>dynamic</entry> - <entry><option>-O0</option></entry> - </row> - </tbody> - </tgroup> - </informaltable> - - </sect2> - <sect2> - <title>Individual optimisations</title> - - <para><xref linkend="options-f"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fcase-merge</option></entry> - <entry>Enable case-merging. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry><option>-fno-case-merge</option></entry> - </row> - - <row> - <entry><option>-fcse</option></entry> - <entry>Turn on common sub-expression elimination. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-cse</entry> - </row> - - <row> - <entry><option>-fdicts-strict</option></entry> - <entry>Make dictionaries strict</entry> - <entry>static</entry> - <entry><option>-fno-dicts-strict</option></entry> - </row> - - <row> - <entry><option>-fdo-eta-reduction</option></entry> - <entry>Enable eta-reduction. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry><option>-fno-do-eta-reduction</option></entry> - </row> - - <row> - <entry><option>-fdo-lambda-eta-expansion</option></entry> - <entry>Enable lambda eta-reduction</entry> - <entry>dynamic</entry> - <entry><option>-fno-do-lambda-eta-expansion</option></entry> - </row> - - <row> - <entry><option>-feager-blackholing</option></entry> - <entry>Turn on <link linkend="parallel-compile-options">eager blackholing</link></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fenable-rewrite-rules</option></entry> - <entry>Switch on all rewrite rules (including rules - generated by automatic specialisation of overloaded functions). - Implied by <option>-O</option>. </entry> - <entry>dynamic</entry> - <entry><option>-fno-enable-rewrite-rules</option></entry> - </row> - - <row> - <entry><option>-fexcess-precision</option></entry> - <entry>Enable excess intermediate precision</entry> - <entry>dynamic</entry> - <entry><option>-fno-excess-precision</option></entry> - </row> - - <row> - <entry><option>-ffloat-in</option></entry> - <entry>Turn on the float-in transformation. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-float-in</entry> - </row> - - <row> - <entry><option>-ffull-laziness</option></entry> - <entry>Turn on full laziness (floating bindings outwards). Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-full-laziness</entry> - </row> - - <row> - <entry><option>-fignore-asserts</option></entry> - <entry>Ignore assertions in the source</entry> - <entry>dynamic</entry> - <entry><option>-fno-ignore-asserts</option></entry> - </row> - - <row> - <entry><option>-fignore-interface-pragmas</option></entry> - <entry>Ignore pragmas in interface files</entry> - <entry>dynamic</entry> - <entry><option>-fno-ignore-interface-pragmas</option></entry> - </row> - - <row> - <entry><option>-fliberate-case</option></entry> - <entry>Turn on the liberate-case transformation. Implied by <option>-O2</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-liberate-case</entry> - </row> - - <row> - <entry><option>-fliberate-case-threshold</option>=<replaceable>n</replaceable></entry> - <entry>Set the size threshold for the liberate-case transformation to <replaceable>n</replaceable> (default: 200)</entry> - <entry>static</entry> - <entry><option>-fno-liberate-case-threshold</option></entry> - </row> - - <row> - <entry><option>-fmax-simplifier-iterations</option></entry> - <entry>Set the max iterations for the simplifier</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fmax-worker-args</option></entry> - <entry>If a worker has that many arguments, none will be - unpacked anymore (default: 10)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fno-opt-coercion</option></entry> - <entry>Turn off the coercion optimiser</entry> - <entry>static</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fno-pre-inlining</option></entry> - <entry>Turn off pre-inlining</entry> - <entry>static</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fno-state-hack</option></entry> - <entry>Turn off the "state hack" whereby any lambda with a real-world state token - as argument is considered to be single-entry. Hence OK to inline things inside it.</entry> - <entry>static</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fpedantic-bottoms</option></entry> - <entry>Make GHC be more precise about its treatment of bottom (but see also - <option>-fno-state-hack</option>). In particular, GHC will not - eta-expand through a case expression.</entry> - <entry>dynamic</entry> - <entry><option>-fno-pedantic-bottoms</option></entry> - </row> - - <row> - <entry><option>-fomit-interface-pragmas</option></entry> - <entry>Don't generate interface pragmas</entry> - <entry>dynamic</entry> - <entry><option>-fno-omit-interface-pragmas</option></entry> - </row> - - <row> - <entry><option>-fsimplifier-phases</option></entry> - <entry>Set the number of phases for the simplifier (default 2). + </row> + + <row> + <entry><option>-fwarn-missing-fields</option></entry> + <entry>warn when fields of a record are uninitialised</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-missing-fields</option></entry> + </row> + + <row> + <entry><option>-fwarn-missing-import-lists</option></entry> + <entry>warn when an import declaration does not explicitly + list all the names brought into scope</entry> + <entry>dynamic</entry> + <entry><option>-fnowarn-missing-import-lists</option></entry> + </row> + + <row> + <entry><option>-fwarn-missing-methods</option></entry> + <entry>warn when class methods are undefined</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-missing-methods</option></entry> + </row> + + <row> + <entry><option>-fwarn-missing-signatures</option></entry> + <entry>warn about top-level functions without signatures</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-missing-signatures</option></entry> + </row> + + <row> + <entry><option>-fwarn-missing-local-sigs</option></entry> + <entry>warn about polymorphic local bindings without signatures</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-missing-local-sigs</option></entry> + </row> + + <row> + <entry><option>-fwarn-monomorphism-restriction</option></entry> + <entry>warn when the Monomorphism Restriction is applied</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-monomorphism-restriction</option></entry> + </row> + + <row> + <entry><option>-fwarn-name-shadowing</option></entry> + <entry>warn when names are shadowed</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-name-shadowing</option></entry> + </row> + + <row> + <entry><option>-fwarn-orphans</option></entry> + <entry>warn when the module contains <link linkend="orphan-modules">orphan instance declarations + or rewrite rules</link></entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-orphans</option></entry> + </row> + + <row> + <entry><option>-fwarn-overlapping-patterns</option></entry> + <entry>warn about overlapping patterns</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-overlapping-patterns</option></entry> + </row> + + <row> + <entry><option>-fwarn-tabs</option></entry> + <entry>warn if there are tabs in the source file</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-tabs</option></entry> + </row> + + <row> + <entry><option>-fwarn-type-defaults</option></entry> + <entry>warn when defaulting happens</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-type-defaults</option></entry> + </row> + + <row> + <entry><option>-fwarn-unrecognised-pragmas</option></entry> + <entry>warn about uses of pragmas that GHC doesn't recognise</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unrecognised-pragmas</option></entry> + </row> + + <row> + <entry><option>-fwarn-unused-binds</option></entry> + <entry>warn about bindings that are unused</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unused-binds</option></entry> + </row> + + <row> + <entry><option>-fwarn-unused-imports</option></entry> + <entry>warn about unnecessary imports</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unused-imports</option></entry> + </row> + + <row> + <entry><option>-fwarn-unused-matches</option></entry> + <entry>warn about variables in patterns that aren't used</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unused-matches</option></entry> + </row> + + <row> + <entry><option>-fwarn-unused-do-bind</option></entry> + <entry>warn about do bindings that appear to throw away values of types other than <literal>()</literal></entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unused-do-bind</option></entry> + </row> + + <row> + <entry><option>-fwarn-wrong-do-bind</option></entry> + <entry>warn about do bindings that appear to throw away monadic values that you should have bound instead</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-wrong-do-bind</option></entry> + </row> + + <row> + <entry><option>-fwarn-unsafe</option></entry> + <entry>warn if the module being compiled is regarded to be unsafe. + Should be used to check the safety status of modules when using safe + inference.</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-unsafe</option></entry> + </row> + + <row> + <entry><option>-fwarn-safe</option></entry> + <entry>warn if the module being compiled is regarded to be safe. + Should be used to check the safety status of modules when using safe + inference.</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-safe</option></entry> + </row> + + <row> + <entry><option>-fwarn-warnings-deprecations</option></entry> + <entry>warn about uses of functions & types that have warnings or deprecated pragmas</entry> + <entry>dynamic</entry> + <entry><option>-fno-warn-warnings-deprecations</option></entry> + </row> + + </tbody> + </tgroup> + </informaltable> + + </sect2> + <sect2> + <title>Optimisation levels</title> + + <para><xref linkend="options-optimise"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-O</option></entry> + <entry>Enable default optimisation (level 1)</entry> + <entry>dynamic</entry> + <entry><option>-O0</option></entry> + </row> + <row> + <entry><option>-O</option><replaceable>n</replaceable></entry> + <entry>Set optimisation level <replaceable>n</replaceable></entry> + <entry>dynamic</entry> + <entry><option>-O0</option></entry> + </row> + </tbody> + </tgroup> + </informaltable> + + </sect2> + <sect2> + <title>Individual optimisations</title> + + <para><xref linkend="options-f"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fcase-merge</option></entry> + <entry>Enable case-merging. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry><option>-fno-case-merge</option></entry> + </row> + + <row> + <entry><option>-fcse</option></entry> + <entry>Turn on common sub-expression elimination. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-cse</entry> + </row> + + <row> + <entry><option>-fdicts-strict</option></entry> + <entry>Make dictionaries strict</entry> + <entry>static</entry> + <entry><option>-fno-dicts-strict</option></entry> + </row> + + <row> + <entry><option>-fdo-eta-reduction</option></entry> + <entry>Enable eta-reduction. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry><option>-fno-do-eta-reduction</option></entry> + </row> + + <row> + <entry><option>-fdo-lambda-eta-expansion</option></entry> + <entry>Enable lambda eta-reduction</entry> + <entry>dynamic</entry> + <entry><option>-fno-do-lambda-eta-expansion</option></entry> + </row> + + <row> + <entry><option>-feager-blackholing</option></entry> + <entry>Turn on <link linkend="parallel-compile-options">eager blackholing</link></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fenable-rewrite-rules</option></entry> + <entry>Switch on all rewrite rules (including rules + generated by automatic specialisation of overloaded functions). + Implied by <option>-O</option>. </entry> + <entry>dynamic</entry> + <entry><option>-fno-enable-rewrite-rules</option></entry> + </row> + + <row> + <entry><option>-fexcess-precision</option></entry> + <entry>Enable excess intermediate precision</entry> + <entry>dynamic</entry> + <entry><option>-fno-excess-precision</option></entry> + </row> + + <row> + <entry><option>-ffloat-in</option></entry> + <entry>Turn on the float-in transformation. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-float-in</entry> + </row> + + <row> + <entry><option>-ffull-laziness</option></entry> + <entry>Turn on full laziness (floating bindings outwards). Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-full-laziness</entry> + </row> + + <row> + <entry><option>-fignore-asserts</option></entry> + <entry>Ignore assertions in the source</entry> + <entry>dynamic</entry> + <entry><option>-fno-ignore-asserts</option></entry> + </row> + + <row> + <entry><option>-fignore-interface-pragmas</option></entry> + <entry>Ignore pragmas in interface files</entry> + <entry>dynamic</entry> + <entry><option>-fno-ignore-interface-pragmas</option></entry> + </row> + + <row> + <entry><option>-fliberate-case</option></entry> + <entry>Turn on the liberate-case transformation. Implied by <option>-O2</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-liberate-case</entry> + </row> + + <row> + <entry><option>-fliberate-case-threshold</option>=<replaceable>n</replaceable></entry> + <entry>Set the size threshold for the liberate-case transformation to <replaceable>n</replaceable> (default: 200)</entry> + <entry>static</entry> + <entry><option>-fno-liberate-case-threshold</option></entry> + </row> + + <row> + <entry><option>-fllvm-tbaa</option></entry> + <entry>Turn on Typed Based Alias Analysis information in the LLVM + backend. This enables more accurate and alias information in the LLVM + backend for better optimisation. (default: enabled)</entry> + <entry>dynamic</entry> + <entry><option>-fno-llvm-tbaa</option></entry> + </row> + + <row> + <entry><option>-fmax-simplifier-iterations</option></entry> + <entry>Set the max iterations for the simplifier</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fmax-worker-args</option></entry> + <entry>If a worker has that many arguments, none will be + unpacked anymore (default: 10)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fno-opt-coercion</option></entry> + <entry>Turn off the coercion optimiser</entry> + <entry>static</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fno-pre-inlining</option></entry> + <entry>Turn off pre-inlining</entry> + <entry>static</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fno-state-hack</option></entry> + <entry>Turn off the "state hack" whereby any lambda with a real-world state token + as argument is considered to be single-entry. Hence OK to inline things inside it.</entry> + <entry>static</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fpedantic-bottoms</option></entry> + <entry>Make GHC be more precise about its treatment of bottom (but see also + <option>-fno-state-hack</option>). In particular, GHC will not + eta-expand through a case expression.</entry> + <entry>dynamic</entry> + <entry><option>-fno-pedantic-bottoms</option></entry> + </row> + + <row> + <entry><option>-fomit-interface-pragmas</option></entry> + <entry>Don't generate interface pragmas</entry> + <entry>dynamic</entry> + <entry><option>-fno-omit-interface-pragmas</option></entry> + </row> + + <row> + <entry><option>-freg-liveness</option></entry> + <entry>Track STG register liveness to avoid saving and restoring + dead registers, as well as freeing the dead ones for use in + intermediate code. (LLVM backend only, default: enabled). + + Traditionally GHC has reserved a set of machine registers for the + exclusive use of storing a stack pointer, heap pointer and + general purpose function argument registers (these are the so + called STG registers). This optimisation tracks the liveness of + the machine registers the STG registers are mapped to so that the + machine register can be used for other purposes when the STG + register are dead.</entry> + <entry>dynamic</entry> + <entry><option>-fno-reg-liveness</option></entry> + </row> + + <row> + <entry><option>-fsimplifier-phases</option></entry> + <entry>Set the number of phases for the simplifier (default 2). Ignored with <option>-O0</option>.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fsimpl-tick-factor=<replaceable>n</replaceable></option></entry> - <entry>Set the percentage factor for simplifier ticks (default 100)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - - <row> - <entry><option>-fspec-constr</option></entry> - <entry>Turn on the SpecConstr transformation. Implied by <option>-O2</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-spec-constr</entry> - </row> - - <row> - <entry><option>-fspec-constr-threshold</option>=<replaceable>n</replaceable></entry> - <entry>Set the size threshold for the SpecConstr transformation to <replaceable>n</replaceable> (default: 200)</entry> - <entry>static</entry> - <entry><option>-fno-spec-constr-threshold</option></entry> - </row> - - <row> - <entry><option>-fspec-constr-count</option>=<replaceable>n</replaceable></entry> - <entry>Set to <replaceable>n</replaceable> (default: 3) the maximum number of - specialisations that will be created for any one function - by the SpecConstr transformation</entry> - <entry>static</entry> - <entry><option>-fno-spec-constr-count</option></entry> - </row> - - <row> - <entry><option>-fspecialise</option></entry> - <entry>Turn on specialisation of overloaded functions. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-specialise</entry> - </row> - - <row> - <entry><option>-fstrictness</option></entry> - <entry>Turn on strictness analysis. Implied by <option>-O</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-strictness</entry> - </row> + <entry>dynamic</entry> + <entry>-</entry> + </row> - <row> - <entry><option>-fstrictness=before</option>=<replaceable>n</replaceable></entry> - <entry>Run an additional strictness analysis before simplifier -phase <replaceable>n</replaceable></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> + <row> + <entry><option>-fsimpl-tick-factor=<replaceable>n</replaceable></option></entry> + <entry>Set the percentage factor for simplifier ticks (default 100)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fspec-constr</option></entry> + <entry>Turn on the SpecConstr transformation. Implied by <option>-O2</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-spec-constr</entry> + </row> + + <row> + <entry><option>-fspec-constr-threshold</option>=<replaceable>n</replaceable></entry> + <entry>Set the size threshold for the SpecConstr transformation to <replaceable>n</replaceable> (default: 200)</entry> + <entry>static</entry> + <entry><option>-fno-spec-constr-threshold</option></entry> + </row> - <row> - <entry><option>-fstatic-argument-transformation</option></entry> - <entry>Turn on the static argument transformation. Implied by <option>-O2</option>.</entry> - <entry>dynamic</entry> - <entry>-fno-static-argument-transformation</entry> - </row> - - <row> - <entry><option>-funbox-strict-fields</option></entry> - <entry>Flatten strict constructor fields</entry> - <entry>dynamic</entry> - <entry><option>-fno-unbox-strict-fields</option></entry> - </row> - - <row> - <entry><option>-funfolding-creation-threshold</option></entry> - <entry>Tweak unfolding settings</entry> - <entry>static</entry> - <entry><option>-fno-unfolding-creation-threshold</option></entry> - </row> - - <row> - <entry><option>-funfolding-fun-discount</option></entry> - <entry>Tweak unfolding settings</entry> - <entry>static</entry> - <entry><option>-fno-unfolding-fun-discount</option></entry> - </row> - - <row> - <entry><option>-funfolding-keeness-factor</option></entry> - <entry>Tweak unfolding settings</entry> - <entry>static</entry> - <entry><option>-fno-unfolding-keeness-factor</option></entry> - </row> - - <row> - <entry><option>-funfolding-use-threshold</option></entry> - <entry>Tweak unfolding settings</entry> - <entry>static</entry> - <entry><option>-fno-unfolding-use-threshold</option></entry> - </row> - - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Profiling options</title> - - <para><xref linkend="profiling"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-prof</option></entry> - <entry>Turn on profiling</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fprof-auto</option></entry> - <entry>Auto-add <literal>SCC</literal>s to all bindings + <row> + <entry><option>-fspec-constr-count</option>=<replaceable>n</replaceable></entry> + <entry>Set to <replaceable>n</replaceable> (default: 3) the maximum number of + specialisations that will be created for any one function + by the SpecConstr transformation</entry> + <entry>static</entry> + <entry><option>-fno-spec-constr-count</option></entry> + </row> + + <row> + <entry><option>-fspecialise</option></entry> + <entry>Turn on specialisation of overloaded functions. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-specialise</entry> + </row> + + <row> + <entry><option>-fstrictness</option></entry> + <entry>Turn on strictness analysis. Implied by <option>-O</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-strictness</entry> + </row> + + <row> + <entry><option>-fstrictness=before</option>=<replaceable>n</replaceable></entry> + <entry>Run an additional strictness analysis before simplifier + phase <replaceable>n</replaceable></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + + <row> + <entry><option>-fstatic-argument-transformation</option></entry> + <entry>Turn on the static argument transformation. Implied by <option>-O2</option>.</entry> + <entry>dynamic</entry> + <entry>-fno-static-argument-transformation</entry> + </row> + + <row> + <entry><option>-funbox-strict-fields</option></entry> + <entry>Flatten strict constructor fields</entry> + <entry>dynamic</entry> + <entry><option>-fno-unbox-strict-fields</option></entry> + </row> + + <row> + <entry><option>-funfolding-creation-threshold</option></entry> + <entry>Tweak unfolding settings</entry> + <entry>static</entry> + <entry><option>-fno-unfolding-creation-threshold</option></entry> + </row> + + <row> + <entry><option>-funfolding-fun-discount</option></entry> + <entry>Tweak unfolding settings</entry> + <entry>static</entry> + <entry><option>-fno-unfolding-fun-discount</option></entry> + </row> + + <row> + <entry><option>-funfolding-keeness-factor</option></entry> + <entry>Tweak unfolding settings</entry> + <entry>static</entry> + <entry><option>-fno-unfolding-keeness-factor</option></entry> + </row> + + <row> + <entry><option>-funfolding-use-threshold</option></entry> + <entry>Tweak unfolding settings</entry> + <entry>static</entry> + <entry><option>-fno-unfolding-use-threshold</option></entry> + </row> + + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Profiling options</title> + + <para><xref linkend="profiling"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-prof</option></entry> + <entry>Turn on profiling</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fprof-auto</option></entry> + <entry>Auto-add <literal>SCC</literal>s to all bindings not marked INLINE</entry> - <entry>dynamic</entry> - <entry><option>-fno-prof-auto</option></entry> - </row> - <row> - <entry><option>-fprof-auto-top</option></entry> - <entry>Auto-add <literal>SCC</literal>s to all top-level + <entry>dynamic</entry> + <entry><option>-fno-prof-auto</option></entry> + </row> + <row> + <entry><option>-fprof-auto-top</option></entry> + <entry>Auto-add <literal>SCC</literal>s to all top-level bindings not marked INLINE</entry> - <entry>dynamic</entry> - <entry><option>-fno-prof-auto</option></entry> - </row> - <row> - <entry><option>-fprof-auto-exported</option></entry> - <entry>Auto-add <literal>SCC</literal>s to all exported + <entry>dynamic</entry> + <entry><option>-fno-prof-auto</option></entry> + </row> + <row> + <entry><option>-fprof-auto-exported</option></entry> + <entry>Auto-add <literal>SCC</literal>s to all exported bindings not marked INLINE</entry> - <entry>dynamic</entry> - <entry><option>-fno-prof-auto</option></entry> - </row> - <row> - <entry><option>-fprof-cafs</option></entry> - <entry>Auto-add <literal>SCC</literal>s to all CAFs</entry> - <entry>dynamic</entry> - <entry><option>-fno-prof-cafs</option></entry> - </row> - <row> - <entry><option>-fno-prof-count-entries</option></entry> - <entry>Do not collect entry counts</entry> - <entry>dynamic</entry> - <entry><option>-fprof-count-entries</option></entry> - </row> - <row> - <entry><option>-ticky</option></entry> - <entry><link linkend="ticky-ticky">Turn on ticky-ticky profiling</link></entry> - <entry>static</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Program coverage options</title> - - <para><xref linkend="hpc"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fhpc</option></entry> - <entry>Turn on Haskell program coverage instrumentation</entry> - <entry>static</entry> - <entry><option>-</option></entry> - </row> - <row> - <entry><option>-hpcdir dir</option></entry> - <entry>Directory to deposit .mix files during compilation (default is .hpc)</entry> - <entry>dynamic</entry> - <entry><option>-</option></entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Haskell pre-processor options</title> - - <para><xref linkend="pre-processor"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-F</option></entry> - <entry> - Enable the use of a pre-processor - (set with <option>-pgmF</option>) - </entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>C pre-processor options</title> - - <para><xref linkend="c-pre-processor"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-cpp</option></entry> - <entry>Run the C pre-processor on Haskell source files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-D</option><replaceable>symbol</replaceable><optional>=<replaceable>value</replaceable></optional></entry> - <entry>Define a symbol in the C pre-processor</entry> - <entry>dynamic</entry> - <entry><option>-U</option><replaceable>symbol</replaceable></entry> - </row> - <row> - <entry><option>-U</option><replaceable>symbol</replaceable></entry> - <entry>Undefine a symbol in the C pre-processor</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-I</option><replaceable>dir</replaceable></entry> - <entry>Add <replaceable>dir</replaceable> to the - directory search list for <literal>#include</literal> files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Code generation options</title> - - <para><xref linkend="options-codegen"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fasm</option></entry> - <entry>Use the <link linkend="native-code-gen">native code - generator</link></entry> - <entry>dynamic</entry> - <entry>-fllvm</entry> - </row> - <row> - <entry><option>-fllvm</option></entry> - <entry>Compile using the <link linkend="llvm-code-gen">LLVM code - generator</link></entry> - <entry>dynamic</entry> - <entry>-fasm</entry> - </row> - <row> - <entry><option>-fno-code</option></entry> - <entry>Omit code generation</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fbyte-code</option></entry> - <entry>Generate byte-code</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fobject-code</option></entry> - <entry>Generate object code</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Linking options</title> - - <para><xref linkend="options-linker"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-shared</option></entry> - <entry>Generate a shared library (as opposed to an executable)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fPIC</option></entry> - <entry>Generate position-independent code (where available)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dynamic</option></entry> - <entry>Use dynamic Haskell libraries (if available)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dynload</option></entry> - <entry>Selects one of a number of modes for finding shared - libraries at runtime.</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-framework</option> <replaceable>name</replaceable></entry> - <entry>On Darwin/MacOS X only, link in the framework <replaceable>name</replaceable>. - This option corresponds to the <option>-framework</option> option for Apple's Linker.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-framework-path</option> <replaceable>name</replaceable></entry> - <entry>On Darwin/MacOS X only, add <replaceable>dir</replaceable> to the list of - directories searched for frameworks. - This option corresponds to the <option>-F</option> option for Apple's Linker.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-l</option><replaceable>lib</replaceable></entry> - <entry>Link in library <replaceable>lib</replaceable></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-L</option><replaceable>dir</replaceable></entry> - <entry>Add <replaceable>dir</replaceable> to the list of - directories searched for libraries</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-main-is</option></entry> - <entry>Set main module and function</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>--mk-dll</option></entry> - <entry>DLL-creation mode (Windows only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-no-hs-main</option></entry> - <entry>Don't assume this program contains <literal>main</literal></entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-rtsopts</option>, <option>-rtsopts={none,some,all}</option></entry> - <entry>Control whether the RTS behaviour can be tweaked via command-line - flags and the <literal>GHCRTS</literal> environment - variable. Using <literal>none</literal> means no RTS flags can be given; <literal>some</literal> means only a minimum of safe options can be given (the default), and <literal>all</literal> (or no argument at all) means that all RTS flags are permitted.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-with-rtsopts=<replaceable>opts</replaceable></option></entry> - <entry>Set the default RTS options to - <replaceable>opts</replaceable>.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-no-link</option></entry> - <entry>Omit linking</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-split-objs</option></entry> - <entry>Split objects (for libraries)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-static</option></entry> - <entry>Use static Haskell libraries</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-threaded</option></entry> - <entry>Use the threaded runtime</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-debug</option></entry> - <entry>Use the debugging runtime</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-eventlog</option></entry> - <entry>Enable runtime event tracing</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-gen-manifest</option></entry> - <entry>Do not generate a manifest file (Windows only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-embed-manifest</option></entry> - <entry>Do not embed the manifest in the executable (Windows only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-shared-implib</option></entry> - <entry>Don't generate an import library for a DLL (Windows only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dylib-install-name</option> <replaceable>path</replaceable></entry> - <entry>Set the install name (via <literal>-install_name</literal> passed to Apple's + <entry>dynamic</entry> + <entry><option>-fno-prof-auto</option></entry> + </row> + <row> + <entry><option>-fprof-cafs</option></entry> + <entry>Auto-add <literal>SCC</literal>s to all CAFs</entry> + <entry>dynamic</entry> + <entry><option>-fno-prof-cafs</option></entry> + </row> + <row> + <entry><option>-fno-prof-count-entries</option></entry> + <entry>Do not collect entry counts</entry> + <entry>dynamic</entry> + <entry><option>-fprof-count-entries</option></entry> + </row> + <row> + <entry><option>-ticky</option></entry> + <entry><link linkend="ticky-ticky">Turn on ticky-ticky profiling</link></entry> + <entry>static</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Program coverage options</title> + + <para><xref linkend="hpc"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fhpc</option></entry> + <entry>Turn on Haskell program coverage instrumentation</entry> + <entry>static</entry> + <entry><option>-</option></entry> + </row> + <row> + <entry><option>-hpcdir dir</option></entry> + <entry>Directory to deposit .mix files during compilation (default is .hpc)</entry> + <entry>dynamic</entry> + <entry><option>-</option></entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Haskell pre-processor options</title> + + <para><xref linkend="pre-processor"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-F</option></entry> + <entry> + Enable the use of a pre-processor + (set with <option>-pgmF</option>) + </entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>C pre-processor options</title> + + <para><xref linkend="c-pre-processor"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-cpp</option></entry> + <entry>Run the C pre-processor on Haskell source files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-D</option><replaceable>symbol</replaceable><optional>=<replaceable>value</replaceable></optional></entry> + <entry>Define a symbol in the C pre-processor</entry> + <entry>dynamic</entry> + <entry><option>-U</option><replaceable>symbol</replaceable></entry> + </row> + <row> + <entry><option>-U</option><replaceable>symbol</replaceable></entry> + <entry>Undefine a symbol in the C pre-processor</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-I</option><replaceable>dir</replaceable></entry> + <entry>Add <replaceable>dir</replaceable> to the + directory search list for <literal>#include</literal> files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Code generation options</title> + + <para><xref linkend="options-codegen"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fasm</option></entry> + <entry>Use the <link linkend="native-code-gen">native code + generator</link></entry> + <entry>dynamic</entry> + <entry>-fllvm</entry> + </row> + <row> + <entry><option>-fllvm</option></entry> + <entry>Compile using the <link linkend="llvm-code-gen">LLVM code + generator</link></entry> + <entry>dynamic</entry> + <entry>-fasm</entry> + </row> + <row> + <entry><option>-fno-code</option></entry> + <entry>Omit code generation</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fbyte-code</option></entry> + <entry>Generate byte-code</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fobject-code</option></entry> + <entry>Generate object code</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Linking options</title> + + <para><xref linkend="options-linker"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-shared</option></entry> + <entry>Generate a shared library (as opposed to an executable)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fPIC</option></entry> + <entry>Generate position-independent code (where available)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dynamic</option></entry> + <entry>Use dynamic Haskell libraries (if available)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dynload</option></entry> + <entry>Selects one of a number of modes for finding shared + libraries at runtime.</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-framework</option> <replaceable>name</replaceable></entry> + <entry>On Darwin/MacOS X only, link in the framework <replaceable>name</replaceable>. + This option corresponds to the <option>-framework</option> option for Apple's Linker.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-framework-path</option> <replaceable>name</replaceable></entry> + <entry>On Darwin/MacOS X only, add <replaceable>dir</replaceable> to the list of + directories searched for frameworks. + This option corresponds to the <option>-F</option> option for Apple's Linker.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-l</option><replaceable>lib</replaceable></entry> + <entry>Link in library <replaceable>lib</replaceable></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-L</option><replaceable>dir</replaceable></entry> + <entry>Add <replaceable>dir</replaceable> to the list of + directories searched for libraries</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-main-is</option></entry> + <entry>Set main module and function</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>--mk-dll</option></entry> + <entry>DLL-creation mode (Windows only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-no-hs-main</option></entry> + <entry>Don't assume this program contains <literal>main</literal></entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-rtsopts</option>, <option>-rtsopts={none,some,all}</option></entry> + <entry>Control whether the RTS behaviour can be tweaked via command-line + flags and the <literal>GHCRTS</literal> environment + variable. Using <literal>none</literal> means no RTS flags can be given; <literal>some</literal> means only a minimum of safe options can be given (the default), and <literal>all</literal> (or no argument at all) means that all RTS flags are permitted.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-with-rtsopts=<replaceable>opts</replaceable></option></entry> + <entry>Set the default RTS options to + <replaceable>opts</replaceable>.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-no-link</option></entry> + <entry>Omit linking</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-split-objs</option></entry> + <entry>Split objects (for libraries)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-static</option></entry> + <entry>Use static Haskell libraries</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-threaded</option></entry> + <entry>Use the threaded runtime</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-debug</option></entry> + <entry>Use the debugging runtime</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-eventlog</option></entry> + <entry>Enable runtime event tracing</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-gen-manifest</option></entry> + <entry>Do not generate a manifest file (Windows only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-embed-manifest</option></entry> + <entry>Do not embed the manifest in the executable (Windows only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-shared-implib</option></entry> + <entry>Don't generate an import library for a DLL (Windows only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dylib-install-name</option> <replaceable>path</replaceable></entry> + <entry>Set the install name (via <literal>-install_name</literal> passed to Apple's linker), specifying the full install path of the library file. Any libraries or executables that link with it later will pick up that path as their runtime search location for it. (Darwin/MacOS X only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Plugin options</title> - - <para><xref linkend="compiler-plugins"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fplugin</option>=<replaceable>module</replaceable></entry> - <entry>Load a plugin exported by a given module</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fplugin-opt</option>=<replaceable>module:args</replaceable></entry> - <entry>Give arguments to a plugin module; module must be specified with <option>-fplugin</option></entry> - <entry>static</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - - <sect2> - <title>Replacing phases</title> - - <para><xref linkend="replacing-phases"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-pgmL</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the literate pre-processor</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmP</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the C - pre-processor (with <option>-cpp</option> only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmc</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the C compiler</entry> - <entry>dynamic</entry> - <entry>-</entry> - <row> - <entry><option>-pgmlo</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the LLVM optimiser</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmlc</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the LLVM compiler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </row> - <row> - <entry><option>-pgms</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the splitter</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgma</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the assembler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgml</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the linker</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmdll</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the DLL generator</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmF</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the pre-processor - (with <option>-F</option> only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-pgmwindres</option> <replaceable>cmd</replaceable></entry> - <entry>Use <replaceable>cmd</replaceable> as the program for - embedding manifests on Windows.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - <indexterm><primary><option>-pgmL</option></primary></indexterm> - <indexterm><primary><option>-pgmP</option></primary></indexterm> - <indexterm><primary><option>-pgmc</option></primary></indexterm> - <indexterm><primary><option>-pgmlo</option></primary></indexterm> - <indexterm><primary><option>-pgmlc</option></primary></indexterm> - <indexterm><primary><option>-pgma</option></primary></indexterm> - <indexterm><primary><option>-pgml</option></primary></indexterm> - <indexterm><primary><option>-pgmdll</option></primary></indexterm> - <indexterm><primary><option>-pgmF</option></primary></indexterm> - - </sect2> - - <sect2> - <title>Forcing options to particular phases</title> - - <para><xref linkend="forcing-options-through"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-optL</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the literate pre-processor</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optP</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to cpp (with - <option>-cpp</option> only)</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optF</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the - custom pre-processor</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optc</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the C compiler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optlo</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the LLVM optimiser</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optlc</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the LLVM compiler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optm</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the mangler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-opta</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the assembler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optl</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the linker</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optdll</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to the DLL generator</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-optwindres</option> <replaceable>option</replaceable></entry> - <entry>pass <replaceable>option</replaceable> to <literal>windres</literal>.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Platform-specific options</title> - - <para><xref linkend="options-platform"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Plugin options</title> + + <para><xref linkend="compiler-plugins"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fplugin</option>=<replaceable>module</replaceable></entry> + <entry>Load a plugin exported by a given module</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fplugin-opt</option>=<replaceable>module:args</replaceable></entry> + <entry>Give arguments to a plugin module; module must be specified with <option>-fplugin</option></entry> + <entry>static</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + + <sect2> + <title>Replacing phases</title> + + <para><xref linkend="replacing-phases"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-pgmL</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the literate pre-processor</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgmP</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the C + pre-processor (with <option>-cpp</option> only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgmc</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the C compiler</entry> + <entry>dynamic</entry> + <entry>-</entry> + <row> + <entry><option>-pgmlo</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the LLVM optimiser</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> <row> - <entry><option>-msse2</option></entry> - <entry>(x86 only) Use SSE2 for floating point</entry> - <entry>dynamic</entry> - <entry>-</entry> + <entry><option>-pgmlc</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the LLVM compiler</entry> + <entry>dynamic</entry> + <entry>-</entry> </row> - </tbody> - <tbody> - <row> - <entry><option>-monly-[432]-regs</option></entry> - <entry>(x86 only) give some registers back to the C compiler</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - - <sect2> - <title>External core file options</title> - - <para><xref linkend="ext-core"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fext-core</option></entry> - <entry>Generate <filename>.hcr</filename> external Core files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - - <sect2> - <title>Compiler debugging options</title> - - <para><xref linkend="options-debugging"/></para> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-dcore-lint</option></entry> - <entry>Turn on internal sanity checking</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-to-file</option></entry> - <entry>Dump to files instead of stdout</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-asm</option></entry> - <entry>Dump assembly</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-bcos</option></entry> - <entry>Dump interpreter byte code</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-cmm</option></entry> - <entry>Dump C-- output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-core-stats</option></entry> - <entry>Print a one-line summary of the size of the Core program - at the end of the optimisation pipeline </entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-cpranal</option></entry> - <entry>Dump output from CPR analysis</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-cse</option></entry> - <entry>Dump CSE output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-deriv</option></entry> - <entry>Dump deriving output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-ds</option></entry> - <entry>Dump desugarer output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-flatC</option></entry> - <entry>Dump “flat” C</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-foreign</option></entry> - <entry>Dump <literal>foreign export</literal> stubs</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-hpc</option></entry> - <entry>Dump after instrumentation for program coverage</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-inlinings</option></entry> - <entry>Dump inlining info</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-llvm</option></entry> - <entry>Dump LLVM intermediate code</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-occur-anal</option></entry> - <entry>Dump occurrence analysis output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-opt-cmm</option></entry> - <entry>Dump the results of C-- to C-- optimising passes</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-parsed</option></entry> - <entry>Dump parse tree</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-prep</option></entry> - <entry>Dump prepared core</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rn</option></entry> - <entry>Dump renamer output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rule-firings</option></entry> - <entry>Dump rule firing info</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rule-rewrites</option></entry> - <entry>Dump detailed rule firing info</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rules</option></entry> - <entry>Dump rules</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-vect</option></entry> - <entry>Dump vectoriser input and output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-simpl</option></entry> - <entry>Dump final simplifier output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-simpl-phases</option></entry> - <entry>Dump output from each simplifier phase</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-simpl-iterations</option></entry> - <entry>Dump output from each simplifier iteration</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-spec</option></entry> - <entry>Dump specialiser output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-splices</option></entry> - <entry>Dump TH spliced expressions, and what they evaluate to</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-stg</option></entry> - <entry>Dump final STG</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-stranal</option></entry> - <entry>Dump strictness analyser output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-tc</option></entry> - <entry>Dump typechecker output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-types</option></entry> - <entry>Dump type signatures</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-worker-wrapper</option></entry> - <entry>Dump worker-wrapper output</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-if-trace</option></entry> - <entry>Trace interface files</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-tc-trace</option></entry> - <entry>Trace typechecker</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-vt-trace</option></entry> - <entry>Trace vectoriser</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rn-trace</option></entry> - <entry>Trace renamer</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-rn-stats</option></entry> - <entry>Renamer stats</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-ddump-simpl-stats</option></entry> - <entry>Dump simplifier stats</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dno-debug-output</option></entry> - <entry>Suppress unsolicited debugging output</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dppr-debug</option></entry> - <entry>Turn on debug printing (more verbose)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dppr-noprags</option></entry> - <entry>Don't output pragma info in dumps</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dppr-user-length</option></entry> - <entry>Set the depth for printing expressions in error msgs</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dppr-colsNNN</option></entry> - <entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dppr-case-as-let</option></entry> - <entry>Print single alternative case expressions as strict lets.</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-all</option></entry> - <entry>In core dumps, suppress everything that is suppressable.</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-uniques</option></entry> - <entry>Suppress the printing of uniques in debug output (easier to use <command>diff</command>)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-idinfo</option></entry> - <entry>Suppress extended information about identifiers where they are bound</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-module-prefixes</option></entry> - <entry>Suppress the printing of module qualification prefixes</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-type-signatures</option></entry> - <entry>Suppress type signatures</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-type-applications</option></entry> - <entry>Suppress type applications</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsuppress-coercions</option></entry> - <entry>Suppress the printing of coercions in Core dumps to make them shorter</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dsource-stats</option></entry> - <entry>Dump haskell source stats</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dcmm-lint</option></entry> - <entry>C-- pass sanity checking</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dstg-lint</option></entry> - <entry>STG pass sanity checking</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dstg-stats</option></entry> - <entry>Dump STG stats</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dverbose-core2core</option></entry> - <entry>Show output from each core-to-core pass</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dverbose-stg2stg</option></entry> - <entry>Show output from each STG-to-STG pass</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dshow-passes</option></entry> - <entry>Print out each pass name as it happens</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dfaststring-stats</option></entry> - <entry>Show statistics for fast string usage when finished</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - - <sect2> - <title>Misc compiler options</title> - - <informaltable> - <tgroup cols="4" align="left" colsep="1" rowsep="1"> - <thead> - <row> - <entry>Flag</entry> - <entry>Description</entry> - <entry>Static/Dynamic</entry> - <entry>Reverse</entry> - </row> - </thead> - <tbody> - <row> - <entry><option>-fno-hi-version-check</option></entry> - <entry>Don't complain about <literal>.hi</literal> file mismatches</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-dno-black-holing</option></entry> - <entry>Turn off black holing (probably doesn't work)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fhistory-size</option></entry> - <entry>Set simplification history size</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-funregisterised</option></entry> - <entry><link linkend="unreg">Unregisterised</link> compilation (use <option>-unreg</option> instead)</entry> - <entry>static</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-ghci-history</option></entry> - <entry>Do not use the load/store the GHCi command history from/to <literal>ghci_history</literal>.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - <row> - <entry><option>-fno-ghci-sandbox</option></entry> - <entry>Turn off the GHCi sandbox. Means computations are run in the main thread, rather than a forked thread.</entry> - <entry>dynamic</entry> - <entry>-</entry> - </row> - </tbody> - </tgroup> - </informaltable> - </sect2> - </sect1> + </row> + <row> + <entry><option>-pgms</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the splitter</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgma</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the assembler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgml</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the linker</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgmdll</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the DLL generator</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgmF</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the pre-processor + (with <option>-F</option> only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-pgmwindres</option> <replaceable>cmd</replaceable></entry> + <entry>Use <replaceable>cmd</replaceable> as the program for + embedding manifests on Windows.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + <indexterm><primary><option>-pgmL</option></primary></indexterm> + <indexterm><primary><option>-pgmP</option></primary></indexterm> + <indexterm><primary><option>-pgmc</option></primary></indexterm> + <indexterm><primary><option>-pgmlo</option></primary></indexterm> + <indexterm><primary><option>-pgmlc</option></primary></indexterm> + <indexterm><primary><option>-pgma</option></primary></indexterm> + <indexterm><primary><option>-pgml</option></primary></indexterm> + <indexterm><primary><option>-pgmdll</option></primary></indexterm> + <indexterm><primary><option>-pgmF</option></primary></indexterm> + + </sect2> + + <sect2> + <title>Forcing options to particular phases</title> + + <para><xref linkend="forcing-options-through"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-optL</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the literate pre-processor</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optP</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to cpp (with + <option>-cpp</option> only)</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optF</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the + custom pre-processor</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optc</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the C compiler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optlo</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the LLVM optimiser</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optlc</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the LLVM compiler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optm</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the mangler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-opta</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the assembler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optl</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the linker</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optdll</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to the DLL generator</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-optwindres</option> <replaceable>option</replaceable></entry> + <entry>pass <replaceable>option</replaceable> to <literal>windres</literal>.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Platform-specific options</title> + + <para><xref linkend="options-platform"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-msse2</option></entry> + <entry>(x86 only) Use SSE2 for floating point</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + <tbody> + <row> + <entry><option>-monly-[432]-regs</option></entry> + <entry>(x86 only) give some registers back to the C compiler</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + + <sect2> + <title>External core file options</title> + + <para><xref linkend="ext-core"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fext-core</option></entry> + <entry>Generate <filename>.hcr</filename> external Core files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + + <sect2> + <title>Compiler debugging options</title> + + <para><xref linkend="options-debugging"/></para> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-dcore-lint</option></entry> + <entry>Turn on internal sanity checking</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-to-file</option></entry> + <entry>Dump to files instead of stdout</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-asm</option></entry> + <entry>Dump assembly</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-bcos</option></entry> + <entry>Dump interpreter byte code</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-cmm</option></entry> + <entry>Dump C-- output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-core-stats</option></entry> + <entry>Print a one-line summary of the size of the Core program + at the end of the optimisation pipeline </entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-cpranal</option></entry> + <entry>Dump output from CPR analysis</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-cse</option></entry> + <entry>Dump CSE output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-deriv</option></entry> + <entry>Dump deriving output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-ds</option></entry> + <entry>Dump desugarer output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-flatC</option></entry> + <entry>Dump “flat” C</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-foreign</option></entry> + <entry>Dump <literal>foreign export</literal> stubs</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-hpc</option></entry> + <entry>Dump after instrumentation for program coverage</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-inlinings</option></entry> + <entry>Dump inlining info</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-llvm</option></entry> + <entry>Dump LLVM intermediate code</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-occur-anal</option></entry> + <entry>Dump occurrence analysis output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-opt-cmm</option></entry> + <entry>Dump the results of C-- to C-- optimising passes</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-parsed</option></entry> + <entry>Dump parse tree</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-prep</option></entry> + <entry>Dump prepared core</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rn</option></entry> + <entry>Dump renamer output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rule-firings</option></entry> + <entry>Dump rule firing info</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rule-rewrites</option></entry> + <entry>Dump detailed rule firing info</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rules</option></entry> + <entry>Dump rules</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-vect</option></entry> + <entry>Dump vectoriser input and output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-simpl</option></entry> + <entry>Dump final simplifier output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-simpl-phases</option></entry> + <entry>Dump output from each simplifier phase</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-simpl-iterations</option></entry> + <entry>Dump output from each simplifier iteration</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-spec</option></entry> + <entry>Dump specialiser output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-splices</option></entry> + <entry>Dump TH spliced expressions, and what they evaluate to</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-stg</option></entry> + <entry>Dump final STG</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-stranal</option></entry> + <entry>Dump strictness analyser output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-tc</option></entry> + <entry>Dump typechecker output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-types</option></entry> + <entry>Dump type signatures</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-worker-wrapper</option></entry> + <entry>Dump worker-wrapper output</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-if-trace</option></entry> + <entry>Trace interface files</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-tc-trace</option></entry> + <entry>Trace typechecker</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-vt-trace</option></entry> + <entry>Trace vectoriser</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rn-trace</option></entry> + <entry>Trace renamer</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-rn-stats</option></entry> + <entry>Renamer stats</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-ddump-simpl-stats</option></entry> + <entry>Dump simplifier stats</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dno-debug-output</option></entry> + <entry>Suppress unsolicited debugging output</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dppr-debug</option></entry> + <entry>Turn on debug printing (more verbose)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dppr-noprags</option></entry> + <entry>Don't output pragma info in dumps</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dppr-user-length</option></entry> + <entry>Set the depth for printing expressions in error msgs</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dppr-colsNNN</option></entry> + <entry>Set the width of debugging output. For example <option>-dppr-cols200</option></entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dppr-case-as-let</option></entry> + <entry>Print single alternative case expressions as strict lets.</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-all</option></entry> + <entry>In core dumps, suppress everything that is suppressable.</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-uniques</option></entry> + <entry>Suppress the printing of uniques in debug output (easier to use <command>diff</command>)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-idinfo</option></entry> + <entry>Suppress extended information about identifiers where they are bound</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-module-prefixes</option></entry> + <entry>Suppress the printing of module qualification prefixes</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-type-signatures</option></entry> + <entry>Suppress type signatures</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-type-applications</option></entry> + <entry>Suppress type applications</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsuppress-coercions</option></entry> + <entry>Suppress the printing of coercions in Core dumps to make them shorter</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dsource-stats</option></entry> + <entry>Dump haskell source stats</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dcmm-lint</option></entry> + <entry>C-- pass sanity checking</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dstg-lint</option></entry> + <entry>STG pass sanity checking</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dstg-stats</option></entry> + <entry>Dump STG stats</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dverbose-core2core</option></entry> + <entry>Show output from each core-to-core pass</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dverbose-stg2stg</option></entry> + <entry>Show output from each STG-to-STG pass</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dshow-passes</option></entry> + <entry>Print out each pass name as it happens</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dfaststring-stats</option></entry> + <entry>Show statistics for fast string usage when finished</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> + + <sect2> + <title>Misc compiler options</title> + + <informaltable> + <tgroup cols="4" align="left" colsep="1" rowsep="1"> + <thead> + <row> + <entry>Flag</entry> + <entry>Description</entry> + <entry>Static/Dynamic</entry> + <entry>Reverse</entry> + </row> + </thead> + <tbody> + <row> + <entry><option>-fno-hi-version-check</option></entry> + <entry>Don't complain about <literal>.hi</literal> file mismatches</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-dno-black-holing</option></entry> + <entry>Turn off black holing (probably doesn't work)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fhistory-size</option></entry> + <entry>Set simplification history size</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-funregisterised</option></entry> + <entry><link linkend="unreg">Unregisterised</link> compilation (use <option>-unreg</option> instead)</entry> + <entry>static</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-ghci-history</option></entry> + <entry>Do not use the load/store the GHCi command history from/to <literal>ghci_history</literal>.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + <row> + <entry><option>-fno-ghci-sandbox</option></entry> + <entry>Turn off the GHCi sandbox. Means computations are run in the main thread, rather than a forked thread.</entry> + <entry>dynamic</entry> + <entry>-</entry> + </row> + </tbody> + </tgroup> + </informaltable> + </sect2> +</sect1> <!-- diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 1923a7f8a8..135d8ecded 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -5199,10 +5199,12 @@ is not what we intend when defining length-indexed vectors. </para> <para> -With the <option>-XPolyKinds</option> flag, users can specify better kinds for -their programs. This flag enables two orthogonal but related features: kind -polymorphism and user defined kinds through datatype promotion. With -<option>-XPolyKinds</option>, the example above can then be rewritten to: +With the flags <option>-XPolyKinds</option> and <option>-XDataKinds</option>, +users get access to a richer kind language. +<option>-XPolyKinds</option> enables kind polymorphism, while +<option>-XDataKinds</option> enables user defined kinds through datatype +promotion. With <option>-XDataKinds</option>, the example above can then be +rewritten to: <programlisting> data Nat = Ze | Su Nat @@ -5240,7 +5242,8 @@ class Typeable2 (t :: * -> * -> *) where </para> <para> -Kind polymorphism allows us to merge all these classes into one: +Kind polymorphism (with <option>-XPolyKinds</option>) +allows us to merge all these classes into one: <programlisting> data Proxy t = Proxy @@ -5259,8 +5262,8 @@ Note that the datatype <literal>Proxy</literal> has kind <para> There are some restrictions in the current implementation: <itemizedlist> - <listitem><para>You cannot explicitly abstract over kinds, or mention kind - variables. So the following are all rejected: + <listitem><para>You cannot (yet) explicitly abstract over kinds, or mention + kind variables. So the following are all rejected: <programlisting> data D1 (t :: k) @@ -5284,8 +5287,7 @@ type instance F Int = Maybe <sect2 id="promotion"> <title>Datatype promotion</title> <para> -Along with kind polymorphism comes the ability to define custom named kinds. -With <option>-XPolyKinds</option>, GHC automatically promotes every suitable +With <option>-XDataKinds</option>, GHC automatically promotes every suitable datatype to be a kind, and its (value) constructors to be type constructors. The following types <programlisting> diff --git a/docs/users_guide/runtime_control.xml b/docs/users_guide/runtime_control.xml index 7b2b469a0a..5870092c2b 100644 --- a/docs/users_guide/runtime_control.xml +++ b/docs/users_guide/runtime_control.xml @@ -730,6 +730,10 @@ $ ./prog -f +RTS -H32m -S -RTS -h foo bar <varlistentry> <term> + <option>-T</option> + <indexterm><primary><option>-T</option></primary><secondary>RTS option</secondary></indexterm> + </term> + <term> <option>-t</option><optional><replaceable>file</replaceable></optional> <indexterm><primary><option>-t</option></primary><secondary>RTS option</secondary></indexterm> </term> @@ -751,6 +755,7 @@ $ ./prog -f +RTS -H32m -S -RTS -h foo bar garbage collector, the amount of memory allocated, the maximum size of the heap, and so on. The three variants give different levels of detail: + <option>-T</option> collects the data but produces no output <option>-t</option> produces a single line of output in the same format as GHC's <option>-Rghc-timing</option> option, <option>-s</option> produces a more detailed summary at the @@ -764,6 +769,12 @@ $ ./prog -f +RTS -H32m -S -RTS -h foo bar is sent to <constant>stderr</constant>.</para> <para> + If you use the <literal>-T</literal> flag then, you should + access the statistics using + <ulink url="&libraryBaseLocation;/GHC-Stats.html">GHC.Stats</ulink>. + </para> + + <para> If you use the <literal>-t</literal> flag then, when your program finishes, you will see something like this: </para> @@ -1037,20 +1037,29 @@ publish-docs: # # Directory in which we're going to build the src dist # -SRC_DIST_NAME=ghc-$(ProjectVersion) -SRC_DIST_DIR=$(SRC_DIST_NAME) +SRC_DIST_ROOT = sdistprep +SRC_DIST_BASE_NAME = ghc-$(ProjectVersion) + +SRC_DIST_GHC_NAME = ghc-$(ProjectVersion)-src +SRC_DIST_GHC_ROOT = $(SRC_DIST_ROOT)/ghc +SRC_DIST_GHC_DIR = $(SRC_DIST_GHC_ROOT)/$(SRC_DIST_BASE_NAME) +SRC_DIST_GHC_TARBALL = $(SRC_DIST_ROOT)/$(SRC_DIST_GHC_NAME).tar.bz2 + +SRC_DIST_TESTSUITE_NAME = ghc-$(ProjectVersion)-testsuite +SRC_DIST_TESTSUITE_ROOT = $(SRC_DIST_ROOT)/testsuite-ghc +SRC_DIST_TESTSUITE_DIR = $(SRC_DIST_TESTSUITE_ROOT)/$(SRC_DIST_BASE_NAME) +SRC_DIST_TESTSUITE_TARBALL = $(SRC_DIST_ROOT)/$(SRC_DIST_TESTSUITE_NAME).tar.bz2 # # Files to include in source distributions # -SRC_DIST_DIRS = mk rules docs distrib bindisttest libffi includes utils docs rts compiler ghc driver libraries ghc-tarballs -SRC_DIST_FILES += \ - configure.ac config.guess config.sub configure \ - aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \ - ghc.spec.in ghc.spec settings.in VERSION \ - boot boot-pkgs packages ghc.mk - -SRC_DIST_TARBALL = $(SRC_DIST_NAME)-src.tar.bz2 +SRC_DIST_GHC_DIRS = mk rules docs distrib bindisttest libffi includes \ + utils docs rts compiler ghc driver libraries ghc-tarballs +SRC_DIST_GHC_FILES += \ + configure.ac config.guess config.sub configure \ + aclocal.m4 README ANNOUNCE HACKING LICENSE Makefile install-sh \ + ghc.spec.in ghc.spec settings.in VERSION \ + boot boot-pkgs packages ghc.mk VERSION : echo $(ProjectVersion) >VERSION @@ -1058,50 +1067,66 @@ VERSION : sdist : VERSION # Use: -# $(call sdist_file,compiler,stage2,cmm,Foo/Bar,CmmLex,x) +# $(call sdist_ghc_file,compiler,stage2,cmm,Foo/Bar,CmmLex,x) # to copy the generated file that replaces compiler/cmm/Foo/Bar/CmmLex.x, where # "stage2" is the dist dir. -define sdist_file - "$(CP)" $1/$2/build/$4/$5.hs $(SRC_DIST_DIR)/$1/$3/$4 - mv $(SRC_DIST_DIR)/$1/$3/$4/$5.$6 $(SRC_DIST_DIR)/$1/$3/$4/$5.$6.source +define sdist_ghc_file + "$(CP)" $1/$2/build/$4/$5.hs $(SRC_DIST_GHC_DIR)/$1/$3/$4 + mv $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6 $(SRC_DIST_GHC_DIR)/$1/$3/$4/$5.$6.source endef -.PHONY: sdist-prep -sdist-prep : - $(call removeTrees,$(SRC_DIST_DIR)) - $(call removeFiles,$(SRC_DIST_TARBALL)) - mkdir $(SRC_DIST_DIR) - cd $(SRC_DIST_DIR) && for i in $(SRC_DIST_DIRS); do mkdir $$i; ( cd $$i && lndir $(TOP)/$$i ); done - cd $(SRC_DIST_DIR) && for i in $(SRC_DIST_FILES); do $(LN_S) $(TOP)/$$i .; done - cd $(SRC_DIST_DIR) && $(MAKE) distclean - $(call removeTrees,$(SRC_DIST_DIR)/libraries/tarballs/) - $(call removeTrees,$(SRC_DIST_DIR)/libraries/stamp/) - $(call sdist_file,compiler,stage2,cmm,,CmmLex,x) - $(call sdist_file,compiler,stage2,cmm,,CmmParse,y) - $(call sdist_file,compiler,stage2,parser,,Lexer,x) - $(call sdist_file,compiler,stage2,parser,,Parser,y.pp) - $(call sdist_file,compiler,stage2,parser,,ParserCore,y) - $(call sdist_file,utils/hpc,dist-install,,,HpcParser,y) - $(call sdist_file,utils/genprimopcode,dist,,,Lexer,x) - $(call sdist_file,utils/genprimopcode,dist,,,Parser,y) - $(call sdist_file,utils/haddock,dist,src,Haddock,Lex,x) - $(call sdist_file,utils/haddock,dist,src,Haddock,Parse,y) - cd $(SRC_DIST_DIR) && $(call removeTrees,compiler/stage[123] mk/build.mk) - cd $(SRC_DIST_DIR) && "$(FIND)" $(SRC_DIST_DIRS) \( -name .git -o -name "autom4te*" -o -name "*~" -o -name "\#*" -o -name ".\#*" -o -name "log" -o -name "*-SAVE" -o -name "*.orig" -o -name "*.rej" \) -print | "$(XARGS)" $(XARGS_OPTS) "$(RM)" $(RM_OPTS_REC) +.PHONY: sdist-ghc-prep +sdist-ghc-prep : + $(call removeTrees,$(SRC_DIST_GHC_ROOT)) + $(call removeFiles,$(SRC_DIST_GHC_TARBALL)) + -mkdir $(SRC_DIST_ROOT) + mkdir $(SRC_DIST_GHC_ROOT) + mkdir $(SRC_DIST_GHC_DIR) + cd $(SRC_DIST_GHC_DIR) && for i in $(SRC_DIST_GHC_DIRS); do mkdir $$i; ( cd $$i && lndir $(TOP)/$$i ); done + cd $(SRC_DIST_GHC_DIR) && for i in $(SRC_DIST_GHC_FILES); do $(LN_S) $(TOP)/$$i .; done + cd $(SRC_DIST_GHC_DIR) && $(MAKE) distclean + $(call removeTrees,$(SRC_DIST_GHC_DIR)/libraries/tarballs/) + $(call removeTrees,$(SRC_DIST_GHC_DIR)/libraries/stamp/) + $(call removeTrees,$(SRC_DIST_GHC_DIR)/compiler/stage[123]) + $(call removeFiles,$(SRC_DIST_GHC_DIR)/mk/build.mk) + $(call sdist_ghc_file,compiler,stage2,cmm,,CmmLex,x) + $(call sdist_ghc_file,compiler,stage2,cmm,,CmmParse,y) + $(call sdist_ghc_file,compiler,stage2,parser,,Lexer,x) + $(call sdist_ghc_file,compiler,stage2,parser,,Parser,y.pp) + $(call sdist_ghc_file,compiler,stage2,parser,,ParserCore,y) + $(call sdist_ghc_file,utils/hpc,dist-install,,,HpcParser,y) + $(call sdist_ghc_file,utils/genprimopcode,dist,,,Lexer,x) + $(call sdist_ghc_file,utils/genprimopcode,dist,,,Parser,y) + $(call sdist_ghc_file,utils/haddock,dist,src,Haddock,Lex,x) + $(call sdist_ghc_file,utils/haddock,dist,src,Haddock,Parse,y) + cd $(SRC_DIST_GHC_DIR) && "$(FIND)" $(SRC_DIST_GHC_DIRS) \( -name .git -o -name "autom4te*" -o -name "*~" -o -name "\#*" -o -name ".\#*" -o -name "log" -o -name "*-SAVE" -o -name "*.orig" -o -name "*.rej" \) -print | "$(XARGS)" $(XARGS_OPTS) "$(RM)" $(RM_OPTS_REC) + +.PHONY: sdist-testsuite-prep +sdist-testsuite-prep : + $(call removeTrees,$(SRC_DIST_TESTSUITE_ROOT)) + $(call removeFiles,$(SRC_DIST_TESTSUITE_TARBALL)) + -mkdir $(SRC_DIST_ROOT) + mkdir $(SRC_DIST_TESTSUITE_ROOT) + mkdir $(SRC_DIST_TESTSUITE_DIR) + mkdir $(SRC_DIST_TESTSUITE_DIR)/testsuite + cd $(SRC_DIST_TESTSUITE_DIR)/testsuite && lndir $(TOP)/testsuite + $(call removeTrees,$(SRC_DIST_TESTSUITE_DIR)/testsuite/.git) .PHONY: sdist -sdist : sdist-prep - "$(TAR_CMD)" chf - $(SRC_DIST_NAME) 2>src_log | bzip2 >$(TOP)/$(SRC_DIST_TARBALL) +sdist : sdist-ghc-prep sdist-testsuite-prep + cd $(SRC_DIST_GHC_ROOT) && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> src_ghc_log | bzip2 > $(TOP)/$(SRC_DIST_GHC_TARBALL) + cd $(SRC_DIST_TESTSUITE_ROOT) && "$(TAR_CMD)" chf - $(SRC_DIST_BASE_NAME) 2> src_ghc_log | bzip2 > $(TOP)/$(SRC_DIST_TESTSUITE_TARBALL) -sdist-manifest : $(SRC_DIST_TARBALL) - tar tjf $(SRC_DIST_TARBALL) | sed "s|^ghc-$(ProjectVersion)/||" | sort >sdist-manifest +sdist-manifest : $(SRC_DIST_GHC_TARBALL) + tar tjf $(SRC_DIST_GHC_TARBALL) | sed "s|^ghc-$(ProjectVersion)/||" | sort >sdist-manifest # Upload the distribution(s) # Retrying is to work around buggy firewalls that corrupt large file transfers # over SSH. ifneq "$(PublishLocation)" "" publish-sdist : - $(call try10Times,$(PublishCp) $(SRC_DIST_TARBALL) $(PublishLocation)/dist) + $(call try10Times,$(PublishCp) $(SRC_DIST_GHC_TARBALL) $(PublishLocation)/dist) + $(call try10Times,$(PublishCp) $(SRC_DIST_TESTSUITE_TARBALL) $(PublishLocation)/dist) endif ifeq "$(BootingFromHc)" "YES" diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 1d243beace..1836087577 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -220,7 +220,7 @@ helpText = " :quit exit GHCi\n" ++ " :reload reload the current module set\n" ++ " :run function [<arguments> ...] run the function with the given arguments\n" ++ - " :script <filename> run the script <filename>" ++ + " :script <filename> run the script <filename>\n" ++ " :type <expr> show the type of <expr>\n" ++ " :undef <cmd> undefine user-defined command :<cmd>\n" ++ " :!<command> run the shell command <command>\n" ++ diff --git a/includes/Rts.h b/includes/Rts.h index 45c09f8fb7..3360eda323 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -166,7 +166,7 @@ typedef StgInt64 Time; #if TIME_RESOLUTION == 1000000000 // I'm being lazy, but it's awkward to define fully general versions of these -#define TimeToUS(t) (t / 1000) +#define TimeToUS(t) ((t) / 1000) #define TimeToNS(t) (t) #define USToTime(t) ((Time)(t) * 1000) #define NSToTime(t) ((Time)(t)) diff --git a/libraries/bin-package-db/bin-package-db.cabal b/libraries/bin-package-db/bin-package-db.cabal index 697b954f30..6a40de0255 100644 --- a/libraries/bin-package-db/bin-package-db.cabal +++ b/libraries/bin-package-db/bin-package-db.cabal @@ -25,7 +25,7 @@ Library { build-depends: base >= 4 && < 5 build-depends: binary == 0.5.*, - Cabal >= 1.8 && < 1.14 + Cabal >= 1.8 && < 1.16 extensions: CPP } diff --git a/mk/build.mk.sample b/mk/build.mk.sample index 10ab7afc76..e979f3990e 100644 --- a/mk/build.mk.sample +++ b/mk/build.mk.sample @@ -10,6 +10,9 @@ # Full build with max optimisation and everything enabled (very slow build) #BuildFlavour = perf +# As above but build GHC using the LLVM backend +#BuildFlavour = perf-llvm + # Fast build with optimised libraries, no profiling (RECOMMENDED): #BuildFlavour = quick @@ -51,6 +54,23 @@ endif endif +# ---------------- Perf build using LLVM ------------------------------------- + +ifeq "$(BuildFlavour)" "perf-llvm" + +SRC_HC_OPTS = -O -H64m -fllvm +GhcStage1HcOpts = -O -fllvm +GhcStage2HcOpts = -O2 -fllvm +GhcHcOpts = -Rghc-timing +GhcLibHcOpts = -O2 +GhcLibWays += p + +ifeq "$(PlatformSupportsSharedLibs)" "YES" +GhcLibWays += dyn +endif + +endif + # -------- A Fast build ------------------------------------------------------ ifeq "$(BuildFlavour)" "quickest" @@ -151,10 +171,14 @@ endif ifeq "$(BuildFlavour)" "unreg" +# Note that the LLVM backend works in unregisterised mode as well as +# registerised mode. This often makes it a good choice for porting +# GHC. + GhcUnregisterised = YES GhcWithNativeCodeGen = NO -SRC_HC_OPTS = -O -H64m +SRC_HC_OPTS = -O -H64m # -fllvm GhcStage1HcOpts = -O GhcStage2HcOpts = -O2 GhcHcOpts = -Rghc-timing @@ -173,3 +197,4 @@ endif # NoFib settings NoFibWays = STRIP_CMD = : + diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index 688cd02a80..303b6ec018 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -66,6 +66,9 @@ libraries/Cabal/Cabal_dist-install_EXTRA_HC_OPTS += -w # Temporarily turn off incomplete-pattern warnings for containers libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-incomplete-patterns +# Temporarily turn off pointless-pragma warnings for containers +libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-pointless-pragmas + # bytestring has identities at the moment libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-identities diff --git a/rts/Capability.c b/rts/Capability.c index 3177e3bcde..54f9196b99 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -228,6 +228,7 @@ initCapability( Capability *cap, nat i ) cap->no = i; cap->in_haskell = rtsFalse; cap->idle = 0; + cap->disabled = rtsFalse; cap->run_queue_hd = END_TSO_QUEUE; cap->run_queue_tl = END_TSO_QUEUE; diff --git a/rts/Stats.c b/rts/Stats.c index 43a776053e..83c43f0bdd 100644 --- a/rts/Stats.c +++ b/rts/Stats.c @@ -564,10 +564,9 @@ stat_exit(int alloc) // heapCensus() is called by the GC, so RP and HC time are // included in the GC stats. We therefore subtract them to - // obtain the actual GC cpu time. XXX: we aren't doing this - // for elapsed time. - gc_cpu -= 0 + PROF_VAL(RP_tot_time + HC_tot_time); - gc_elapsed -= 0 + PROF_VAL(RPe_tot_time + HCe_tot_time); + // obtain the actual GC cpu time. + gc_cpu -= PROF_VAL(RP_tot_time + HC_tot_time); + gc_elapsed -= PROF_VAL(RPe_tot_time + HCe_tot_time); init_cpu = get_init_cpu(); init_elapsed = get_init_elapsed(); diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c index ece54910c2..d928147af8 100644 --- a/rts/posix/Itimer.c +++ b/rts/posix/Itimer.c @@ -155,7 +155,7 @@ startTicker(void) struct itimerspec it; it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_nsec = TimeToNS(itimer_interval); + it.it_value.tv_nsec = TimeToNS(itimer_interval) % 1000000000; it.it_interval = it.it_value; if (timer_settime(timer, 0, &it, NULL) != 0) { @@ -168,7 +168,7 @@ startTicker(void) struct itimerval it; it.it_value.tv_sec = TimeToSeconds(itimer_interval); - it.it_value.tv_usec = TimeToUS(itimer_interval); + it.it_value.tv_usec = TimeToUS(itimer_interval) % 1000000; it.it_interval = it.it_value; if (setitimer(ITIMER_REAL, &it, NULL) != 0) { diff --git a/rts/posix/Select.c b/rts/posix/Select.c index 45737ce0cc..013b374d1a 100644 --- a/rts/posix/Select.c +++ b/rts/posix/Select.c @@ -118,13 +118,9 @@ awaitEvent(rtsBool wait) int maxfd = -1; rtsBool select_succeeded = rtsTrue; rtsBool unblock_all = rtsFalse; - struct timeval tv; - Time min; + struct timeval tv, *ptv; LowResTime now; - tv.tv_sec = 0; - tv.tv_usec = 0; - IF_DEBUG(scheduler, debugBelch("scheduler: checking for threads blocked on I/O"); if (wait) { @@ -145,15 +141,7 @@ awaitEvent(rtsBool wait) return; } - if (!wait) { - min = 0; - } else if (sleeping_queue != END_TSO_QUEUE) { - min = LowResTimeToTime(sleeping_queue->block_info.target - now); - } else { - min = (Time)-1; - } - - /* + /* * Collect all of the fd's that we're interested in */ FD_ZERO(&rfd); @@ -194,12 +182,23 @@ awaitEvent(rtsBool wait) } } + if (!wait) { + // just poll + tv.tv_sec = 0; + tv.tv_usec = 0; + ptv = &tv; + } else if (sleeping_queue != END_TSO_QUEUE) { + Time min = LowResTimeToTime(sleeping_queue->block_info.target - now); + tv.tv_sec = TimeToSeconds(min); + tv.tv_usec = TimeToUS(min) % 1000000; + ptv = &tv; + } else { + ptv = NULL; + } + /* Check for any interesting events */ - tv.tv_sec = TimeToSeconds(min); - tv.tv_usec = TimeToUS(min) % 1000000; - - while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, &tv)) < 0) { + while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, ptv)) < 0) { if (errno != EINTR) { /* Handle bad file descriptors by unblocking all the waiting threads. Why? Because a thread might have been diff --git a/settings.in b/settings.in index 02e1e0eaa0..80741ab2d3 100644 --- a/settings.in +++ b/settings.in @@ -1,7 +1,7 @@ [("GCC extra via C opts", "@GccExtraViaCOpts@"), ("C compiler command", "@SettingsCCompilerCommand@"), ("C compiler flags", "@SettingsCCompilerFlags@"), - ("ar command", "@ArCmd@"), + ("ar command", "@SettingsArCommand@"), ("ar flags", "@ArArgs@"), ("ar supports at file", "@ArSupportsAtFile@"), ("touch command", "@SettingsTouchCommand@"), diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 55a4a188ad..0c45b8357a 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -16,7 +16,7 @@ Executable ghc-cabal Main-Is: ghc-cabal.hs Build-Depends: base >= 3 && < 5, - Cabal >= 1.10 && < 1.14, + Cabal >= 1.10 && < 1.16, directory >= 1.1 && < 1.2, filepath >= 1.2 && < 1.3 |