From: Simon Marlow Date: Mon, 6 Jun 2011 10:39:00 +0000 (+0100) Subject: Merge remote branch 'working/master' X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=d19c829904aec3be6bc807640573fdf5dcf05928;hp=927df6486bc0dcb598b82702ca40c8fad0d9b25f Merge remote branch 'working/master' --- diff --git a/.gitignore b/.gitignore index 3e2e7f4..ac8c70e 100644 --- a/.gitignore +++ b/.gitignore @@ -232,3 +232,5 @@ _darcs/ /utils/runstdtest/runstdtest /utils/unlit/unlit + +/extra-gcc-opts \ No newline at end of file diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs index 5e1ac16..6e89035 100644 --- a/compiler/cmm/CmmMachOp.hs +++ b/compiler/cmm/CmmMachOp.hs @@ -459,7 +459,15 @@ data CallishMachOp | MO_F32_Sqrt | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) + + -- Note that these three MachOps all take 1 extra parameter than the + -- standard C lib versions. The extra (last) parameter contains + -- alignment of the pointers. Used for optimisation in backends. + | MO_Memcpy + | MO_Memset + | MO_Memmove deriving (Eq, Show) pprCallishMachOp :: CallishMachOp -> SDoc pprCallishMachOp mo = text (show mo) + diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index a2eecd5..69df4fb 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -99,11 +99,13 @@ cmmEliminateDeadBlocks blocks@(BasicBlock base_id _:_) = -- The mini-inliner {- -This pass inlines assignments to temporaries that are used just -once. It works as follows: +This pass inlines assignments to temporaries. Temporaries that are +only used once are unconditionally inlined. Temporaries that are used +two or more times are only inlined if they are assigned a literal. It +works as follows: - count uses of each temporary - - for each temporary that occurs just once: + - for each temporary: - attempt to push it forward to the statement that uses it - only push forward past assignments to other temporaries (assumes that temporaries are single-assignment) @@ -159,11 +161,37 @@ cmmMiniInline blocks = map do_inline blocks cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt] cmmMiniInlineStmts uses [] = [] cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts) - -- not used at all: just discard this assignment + -- not used: just discard this assignment | Nothing <- lookupUFM uses u = cmmMiniInlineStmts uses stmts - -- used once: try to inline at the use site + -- used (literal): try to inline at all the use sites + | Just n <- lookupUFM uses u, isLit expr + = +#ifdef NCG_DEBUG + trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $ +#endif + case lookForInlineLit u expr stmts of + (m, stmts') + | n == m -> cmmMiniInlineStmts (delFromUFM uses u) stmts' + | otherwise -> + stmt : cmmMiniInlineStmts (adjustUFM (\x -> x - m) uses u) stmts' + + -- used (foldable to literal): try to inline at all the use sites + | Just n <- lookupUFM uses u, + CmmMachOp op es <- expr, + e@(CmmLit _) <- cmmMachOpFold op es + = +#ifdef NCG_DEBUG + trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $ +#endif + case lookForInlineLit u e stmts of + (m, stmts') + | n == m -> cmmMiniInlineStmts (delFromUFM uses u) stmts' + | otherwise -> + stmt : cmmMiniInlineStmts (adjustUFM (\x -> x - m) uses u) stmts' + + -- used once (non-literal): try to inline at the use site | Just 1 <- lookupUFM uses u, Just stmts' <- lookForInline u expr stmts = @@ -175,6 +203,31 @@ cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts cmmMiniInlineStmts uses (stmt:stmts) = stmt : cmmMiniInlineStmts uses stmts +-- | Takes a register, a 'CmmLit' expression assigned to that +-- register, and a list of statements. Inlines the expression at all +-- use sites of the register. Returns the number of substituations +-- made and the, possibly modified, list of statements. +lookForInlineLit :: Unique -> CmmExpr -> [CmmStmt] -> (Int, [CmmStmt]) +lookForInlineLit _ _ [] = (0, []) +lookForInlineLit u expr stmts@(stmt : rest) + | Just n <- lookupUFM (countUses stmt) u + = case lookForInlineLit u expr rest of + (m, stmts) -> let z = n + m + in z `seq` (z, inlineStmt u expr stmt : stmts) + + | ok_to_skip + = case lookForInlineLit u expr rest of + (n, stmts) -> (n, stmt : stmts) + + | otherwise + = (0, stmts) + where + -- We skip over assignments to registers, unless the register + -- being assigned to is the one we're inlining. + ok_to_skip = case stmt of + CmmAssign (CmmLocal r@(LocalReg u' _)) _ | u' == u -> False + _other -> True + lookForInline u expr stmts = lookForInline' u expr regset stmts where regset = foldRegsUsed extendRegSet emptyRegSet expr diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 0ee429d..6d14be2 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -735,7 +735,10 @@ machOps = listToUFM $ callishMachOps = listToUFM $ map (\(x, y) -> (mkFastString x, y)) [ - ( "write_barrier", MO_WriteBarrier ) + ( "write_barrier", MO_WriteBarrier ), + ( "memcpy", MO_Memcpy ), + ( "memset", MO_Memset ), + ( "memmove", MO_Memmove ) -- ToDo: the rest, maybe ] diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 4df7c77..63d99a6 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -601,13 +601,17 @@ assignTemp e ; stmtC (CmmAssign (CmmLocal reg) e) ; return (CmmReg (CmmLocal reg)) } --- | Assign the expression to a temporary register and return an --- expression referring to this register. +-- | If the expression is trivial and doesn't refer to a global +-- register, return it. Otherwise, assign the expression to a +-- temporary register and return an expression referring to this +-- register. assignTemp_ :: CmmExpr -> FCode CmmExpr -assignTemp_ e = do - reg <- newTemp (cmmExprType e) - stmtC (CmmAssign (CmmLocal reg) e) - return (CmmReg (CmmLocal reg)) +assignTemp_ e + | isTrivialCmmExpr e && hasNoGlobalRegs e = return e + | otherwise = do + reg <- newTemp (cmmExprType e) + stmtC (CmmAssign (CmmLocal reg) e) + return (CmmReg (CmmLocal reg)) newTemp :: CmmType -> FCode LocalReg newTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep) } diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index c80628b..502eefa 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -1508,14 +1508,18 @@ instance Binary name => Binary (AnnTarget name) where return (ModuleTarget a) instance Binary IfaceVectInfo where - put_ bh (IfaceVectInfo a1 a2 a3) = do + put_ bh (IfaceVectInfo a1 a2 a3 a4 a5) = do put_ bh a1 put_ bh a2 put_ bh a3 + put_ bh a4 + put_ bh a5 get bh = do a1 <- get bh a2 <- get bh a3 <- get bh - return (IfaceVectInfo a1 a2 a3) + a4 <- get bh + a5 <- get bh + return (IfaceVectInfo a1 a2 a3 a4 a5) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index e92a160..97acc52 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -729,14 +729,18 @@ pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes pprFix (occ,fix) = ppr fix <+> ppr occ pprVectInfo :: IfaceVectInfo -> SDoc -pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse +pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + , ifaceVectInfoScalarVars = scalarVars + , ifaceVectInfoScalarTyCons = scalarTyCons }) = vcat [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars) , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons) , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) + , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars) + , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons) ] instance Outputable Warnings where diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 5c58a80..0bce56b 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -7,23 +7,23 @@ module MkIface ( mkUsedNames, mkDependencies, - mkIface, -- Build a ModIface from a ModGuts, - -- including computing version information + mkIface, -- Build a ModIface from a ModGuts, + -- including computing version information mkIfaceTc, - writeIfaceFile, -- Write the interface file + writeIfaceFile, -- Write the interface file - checkOldIface, -- See if recompilation is required, by - -- comparing version information + checkOldIface, -- See if recompilation is required, by + -- comparing version information tyThingToIfaceDecl -- Converting things to their Iface equivalents ) where \end{code} - ----------------------------------------------- - Recompilation checking - ----------------------------------------------- + ----------------------------------------------- + Recompilation checking + ----------------------------------------------- A complete description of how recompilation checking works can be found in the wiki commentary: @@ -72,6 +72,7 @@ import HscTypes import Finder import DynFlags import VarEnv +import VarSet import Var import Name import RdrName @@ -325,18 +326,17 @@ mkIface_ hsc_env maybe_old_fingerprint ifFamInstTcName = ifaceTyConName . ifFamInstTyCon - flattenVectInfo (VectInfo { vectInfoVar = vVar - , vectInfoTyCon = vTyCon + flattenVectInfo (VectInfo { vectInfoVar = vVar + , vectInfoTyCon = vTyCon + , vectInfoScalarVars = vScalarVars + , vectInfoScalarTyCons = vScalarTyCons }) = - IfaceVectInfo { - ifaceVectInfoVar = [ Var.varName v - | (v, _) <- varEnvElts vVar], - ifaceVectInfoTyCon = [ tyConName t - | (t, t_v) <- nameEnvElts vTyCon - , t /= t_v], - ifaceVectInfoTyConReuse = [ tyConName t - | (t, t_v) <- nameEnvElts vTyCon - , t == t_v] + IfaceVectInfo + { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- varEnvElts vVar] + , ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v] + , ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v] + , ifaceVectInfoScalarVars = [Var.varName v | v <- varSetElems vScalarVars] + , ifaceVectInfoScalarTyCons = nameSetToList vScalarTyCons } ----------------------------- diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 7ac95b1..5bfb406 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -39,14 +39,16 @@ import Class import TyCon import DataCon import TysWiredIn -import TysPrim ( anyTyConOfKind ) -import BasicTypes ( Arity, nonRuleLoopBreaker ) +import TysPrim ( anyTyConOfKind ) +import BasicTypes ( Arity, nonRuleLoopBreaker ) import qualified Var import VarEnv +import VarSet import Name import NameEnv -import OccurAnal ( occurAnalyseExpr ) -import Demand ( isBottomingSig ) +import NameSet +import OccurAnal ( occurAnalyseExpr ) +import Demand ( isBottomingSig ) import Module import UniqFM import UniqSupply @@ -689,28 +691,32 @@ tcIfaceAnnTarget (ModuleTarget mod) = do %************************************************************************ -%* * - Vectorisation information -%* * +%* * + Vectorisation information +%* * %************************************************************************ \begin{code} tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceVectInfo mod typeEnv (IfaceVectInfo - { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse + { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse + , ifaceVectInfoScalarVars = scalarVars + , ifaceVectInfoScalarTyCons = scalarTyCons }) = do { vVars <- mapM vectVarMapping vars ; tyConRes1 <- mapM vectTyConMapping tycons ; tyConRes2 <- mapM vectTyConReuseMapping tyconsReuse ; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2) ; return $ VectInfo - { vectInfoVar = mkVarEnv vVars - , vectInfoTyCon = mkNameEnv vTyCons - , vectInfoDataCon = mkNameEnv (concat vDataCons) - , vectInfoPADFun = mkNameEnv vPAs - , vectInfoIso = mkNameEnv vIsos + { vectInfoVar = mkVarEnv vVars + , vectInfoTyCon = mkNameEnv vTyCons + , vectInfoDataCon = mkNameEnv (concat vDataCons) + , vectInfoPADFun = mkNameEnv vPAs + , vectInfoIso = mkNameEnv vIsos + , vectInfoScalarVars = mkVarSet (map lookupVar scalarVars) + , vectInfoScalarTyCons = mkNameSet scalarTyCons } } where @@ -778,9 +784,9 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo \end{code} %************************************************************************ -%* * - Types -%* * +%* * + Types +%* * %************************************************************************ \begin{code} diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs index e25f5be..93bc62c 100644 --- a/compiler/llvmGen/Llvm/AbsSyn.hs +++ b/compiler/llvmGen/Llvm/AbsSyn.hs @@ -132,6 +132,12 @@ data LlvmStatement -} | Expr LlvmExpression + {- | + A nop LLVM statement. Useful as its often more efficient to use this + then to wrap LLvmStatement in a Just or []. + -} + | Nop + deriving (Show, Eq) diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index 1a972e7..82c6bfa 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -161,6 +161,7 @@ ppLlvmStatement stmt Return result -> ppReturn result Expr expr -> ppLlvmExpression expr Unreachable -> text "unreachable" + Nop -> empty -- | Print out an LLVM expression. diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index ba5c1ec..56d8386 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -28,7 +28,9 @@ import Outputable import qualified Pretty as Prt import UniqSupply import Util +import SysTools ( figureLlvmVersion ) +import Data.Maybe ( fromMaybe ) import System.IO -- ----------------------------------------------------------------------------- @@ -48,8 +50,9 @@ llvmCodeGen dflags h us cmms in do bufh <- newBufHandle h Prt.bufLeftRender bufh $ pprLlvmHeader - - env' <- cmmDataLlvmGens dflags bufh env cdata [] + ver <- (fromMaybe defaultLlvmVersion) `fmap` figureLlvmVersion dflags + + env' <- cmmDataLlvmGens dflags bufh (setLlvmVer ver env) cdata [] cmmProcLlvmGens dflags bufh us env' cmm 1 [] bFlush bufh diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 80d88e6..221106a 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -9,8 +9,10 @@ module LlvmCodeGen.Base ( LlvmCmmTop, LlvmBasicBlock, LlvmUnresData, LlvmData, UnresLabel, UnresStatic, + LlvmVersion, defaultLlvmVersion, + LlvmEnv, initLlvmEnv, clearVars, varLookup, varInsert, - funLookup, funInsert, + funLookup, funInsert, getLlvmVer, setLlvmVer, cmmToLlvmType, widthToLlvmFloat, widthToLlvmInt, llvmFunTy, llvmFunSig, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign, @@ -128,33 +130,50 @@ tysToParams = map (\ty -> (ty, [])) llvmPtrBits :: Int llvmPtrBits = widthInBits $ typeWidth gcWord +-- ---------------------------------------------------------------------------- +-- * Llvm Version +-- + +-- | LLVM Version Number +type LlvmVersion = Int + +-- | The LLVM Version we assume if we don't know +defaultLlvmVersion :: LlvmVersion +defaultLlvmVersion = 28 -- ---------------------------------------------------------------------------- -- * Environment Handling -- -type LlvmEnvMap = UniqFM LlvmType -- two maps, one for functions and one for local vars. -type LlvmEnv = (LlvmEnvMap, LlvmEnvMap) +newtype LlvmEnv = LlvmEnv (LlvmEnvMap, LlvmEnvMap, LlvmVersion) +type LlvmEnvMap = UniqFM LlvmType -- | Get initial Llvm environment. initLlvmEnv :: LlvmEnv -initLlvmEnv = (emptyUFM, emptyUFM) +initLlvmEnv = LlvmEnv (emptyUFM, emptyUFM, defaultLlvmVersion) -- | Clear variables from the environment. clearVars :: LlvmEnv -> LlvmEnv -clearVars (e1, _) = (e1, emptyUFM) +clearVars (LlvmEnv (e1, _, n)) = LlvmEnv (e1, emptyUFM, n) -- | Insert functions into the environment. varInsert, funInsert :: Uniquable key => key -> LlvmType -> LlvmEnv -> LlvmEnv -varInsert s t (e1, e2) = (e1, addToUFM e2 s t) -funInsert s t (e1, e2) = (addToUFM e1 s t, e2) +varInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (e1, addToUFM e2 s t, n) +funInsert s t (LlvmEnv (e1, e2, n)) = LlvmEnv (addToUFM e1 s t, e2, n) -- | Lookup functions in the environment. varLookup, funLookup :: Uniquable key => key -> LlvmEnv -> Maybe LlvmType -varLookup s (_, e2) = lookupUFM e2 s -funLookup s (e1, _) = lookupUFM e1 s +varLookup s (LlvmEnv (_, e2, _)) = lookupUFM e2 s +funLookup s (LlvmEnv (e1, _, _)) = lookupUFM e1 s + +-- | Get the LLVM version we are generating code for +getLlvmVer :: LlvmEnv -> LlvmVersion +getLlvmVer (LlvmEnv (_, _, n)) = n +-- | Set the LLVM version we are generating code for +setLlvmVer :: LlvmVersion -> LlvmEnv -> LlvmEnv +setLlvmVer n (LlvmEnv (e1, e2, _)) = LlvmEnv (e1, e2, n) -- ---------------------------------------------------------------------------- -- * Label handling diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index f5dd3bb..c55da14 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -fno-warn-type-defaults #-} -- ---------------------------------------------------------------------------- -- | Handle conversion of CmmProc to LLVM code. -- @@ -17,7 +18,6 @@ import OldCmm import qualified OldPprCmm as PprCmm import OrdList -import BasicTypes import FastString import ForeignCall import Outputable hiding ( panic, pprPanic ) @@ -175,9 +175,31 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _ = do where lmTrue :: LlvmVar - lmTrue = LMLitVar $ LMIntLit (-1) i1 + lmTrue = mkIntLit i1 (-1) #endif +-- Handle memcpy function specifically since llvm's intrinsic version takes +-- some extra parameters. +genCall env t@(CmmPrim op) [] args CmmMayReturn | op == MO_Memcpy || + op == MO_Memset || + op == MO_Memmove = do + let (isVolTy, isVolVal) = if getLlvmVer env >= 28 + then ([i1], [mkIntLit i1 0]) else ([], []) + argTy | op == MO_Memset = [i8Ptr, i8, llvmWord, i32] ++ isVolTy + | otherwise = [i8Ptr, i8Ptr, llvmWord, i32] ++ isVolTy + funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible + CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing + + (env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, []) + (env2, fptr, stmts2, top2) <- getFunPtr env1 funTy t + (argVars', stmts3) <- castVars $ zip argVars argTy + + let arguments = argVars' ++ isVolVal + call = Expr $ Call StdCall fptr arguments [] + stmts = stmts1 `appOL` stmts2 `appOL` stmts3 + `appOL` trashStmts `snocOL` call + return (env2, stmts, top1 ++ top2) + -- Handle all other foreign calls and prim ops. genCall env target res args ret = do @@ -225,91 +247,17 @@ genCall env target res args ret = do let ccTy = StdCall -- tail calls should be done through CmmJump let retTy = ret_type res let argTy = tysToParams $ map arg_type args - let funTy name = LMFunction $ LlvmFunctionDecl name ExternallyVisible - lmconv retTy FixedArgs argTy llvmFunAlign + let funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible + lmconv retTy FixedArgs argTy llvmFunAlign - -- get parameter values - (env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, []) - -- get the return register - let ret_reg ([CmmHinted reg hint]) = (reg, hint) - ret_reg t = panic $ "genCall: Bad number of registers! Can only handle" - ++ " 1, given " ++ show (length t) ++ "." - - -- deal with call types - let getFunPtr :: CmmCallTarget -> UniqSM ExprData - getFunPtr targ = case targ of - CmmCallee (CmmLit (CmmLabel lbl)) _ -> do - let name = strCLabel_llvm lbl - case funLookup name env1 of - Just ty'@(LMFunction sig) -> do - -- Function in module in right form - let fun = LMGlobalVar name ty' (funcLinkage sig) - Nothing Nothing False - return (env1, fun, nilOL, []) - - Just ty' -> do - -- label in module but not function pointer, convert - let fty@(LMFunction sig) = funTy name - let fun = LMGlobalVar name (pLift ty') (funcLinkage sig) - Nothing Nothing False - (v1, s1) <- doExpr (pLift fty) - $ Cast LM_Bitcast fun (pLift fty) - return (env1, v1, unitOL s1, []) - - Nothing -> do - -- label not in module, create external reference - let fty@(LMFunction sig) = funTy name - let fun = LMGlobalVar name fty (funcLinkage sig) - Nothing Nothing False - let top = CmmData Data [([],[fty])] - let env' = funInsert name fty env1 - return (env', fun, nilOL, [top]) - - CmmCallee expr _ -> do - (env', v1, stmts, top) <- exprToVar env1 expr - let fty = funTy $ fsLit "dynamic" - let cast = case getVarType v1 of - ty | isPointer ty -> LM_Bitcast - ty | isInt ty -> LM_Inttoptr - - ty -> panic $ "genCall: Expr is of bad type for function" - ++ " call! (" ++ show (ty) ++ ")" - - (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty) - return (env', v2, stmts `snocOL` s1, top) - - CmmPrim mop -> do - let name = cmmPrimOpFunctions mop - let lbl = mkForeignLabel name Nothing - ForeignLabelInExternalPackage IsFunction - getFunPtr $ CmmCallee (CmmLit (CmmLabel lbl)) CCallConv - - (env2, fptr, stmts2, top2) <- getFunPtr target + (env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, []) + (env2, fptr, stmts2, top2) <- getFunPtr env1 funTy target let retStmt | ccTy == TailCall = unitOL $ Return Nothing | ret == CmmNeverReturns = unitOL $ Unreachable | otherwise = nilOL - {- In LLVM we pass the STG registers around everywhere in function calls. - So this means LLVM considers them live across the entire function, when - in reality they usually aren't. For Caller save registers across C calls - the saving and restoring of them is done by the Cmm code generator, - using Cmm local vars. So to stop LLVM saving them as well (and saving - all of them since it thinks they're always live, we trash them just - before the call by assigning the 'undef' value to them. The ones we - need are restored from the Cmm local var and the ones we don't need - are fine to be trashed. - -} - let trashStmts = concatOL $ map trashReg activeStgRegs - where trashReg r = - let reg = lmGlobalRegVar r - ty = (pLower . getVarType) reg - trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg - in case callerSaves r of - True -> trash - False -> nilOL - let stmts = stmts1 `appOL` stmts2 `appOL` trashStmts -- make the actual call @@ -321,6 +269,10 @@ genCall env target res args ret = do _ -> do (v1, s1) <- doExpr retTy $ Call ccTy fptr argVars fnAttrs + -- get the return register + let ret_reg ([CmmHinted reg hint]) = (reg, hint) + ret_reg t = panic $ "genCall: Bad number of registers! Can only handle" + ++ " 1, given " ++ show (length t) ++ "." let (creg, _) = ret_reg res let (env3, vreg, stmts3, top3) = getCmmReg env2 (CmmLocal creg) let allStmts = stmts `snocOL` s1 `appOL` stmts3 @@ -344,6 +296,55 @@ genCall env target res args ret = do `appOL` retStmt, top1 ++ top2 ++ top3) +-- | Create a function pointer from a target. +getFunPtr :: LlvmEnv -> (LMString -> LlvmType) -> CmmCallTarget + -> UniqSM ExprData +getFunPtr env funTy targ = case targ of + CmmCallee (CmmLit (CmmLabel lbl)) _ -> litCase $ strCLabel_llvm lbl + + CmmCallee expr _ -> do + (env', v1, stmts, top) <- exprToVar env expr + let fty = funTy $ fsLit "dynamic" + cast = case getVarType v1 of + ty | isPointer ty -> LM_Bitcast + ty | isInt ty -> LM_Inttoptr + + ty -> panic $ "genCall: Expr is of bad type for function" + ++ " call! (" ++ show (ty) ++ ")" + + (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty) + return (env', v2, stmts `snocOL` s1, top) + + CmmPrim mop -> litCase $ cmmPrimOpFunctions env mop + + where + litCase name = do + case funLookup name env of + Just ty'@(LMFunction sig) -> do + -- Function in module in right form + let fun = LMGlobalVar name ty' (funcLinkage sig) + Nothing Nothing False + return (env, fun, nilOL, []) + + Just ty' -> do + -- label in module but not function pointer, convert + let fty@(LMFunction sig) = funTy name + fun = LMGlobalVar name (pLift ty') (funcLinkage sig) + Nothing Nothing False + (v1, s1) <- doExpr (pLift fty) + $ Cast LM_Bitcast fun (pLift fty) + return (env, v1, unitOL s1, []) + + Nothing -> do + -- label not in module, create external reference + let fty@(LMFunction sig) = funTy name + fun = LMGlobalVar name fty (funcLinkage sig) + Nothing Nothing False + top = [CmmData Data [([],[fty])]] + env' = funInsert name fty env + return (env', fun, nilOL, top) + + -- | Conversion of call arguments. arg_vars :: LlvmEnv -> HintedCmmActuals @@ -370,9 +371,41 @@ arg_vars env (CmmHinted e _:rest) (vars, stmts, tops) = do (env', v1, stmts', top') <- exprToVar env e arg_vars env' rest (vars ++ [v1], stmts `appOL` stmts', tops ++ top') + +-- | Cast a collection of LLVM variables to specific types. +castVars :: [(LlvmVar, LlvmType)] + -> UniqSM ([LlvmVar], LlvmStatements) +castVars vars = do + done <- mapM (uncurry castVar) vars + let (vars', stmts) = unzip done + return (vars', toOL stmts) + +-- | Cast an LLVM variable to a specific type, panicing if it can't be done. +castVar :: LlvmVar -> LlvmType -> UniqSM (LlvmVar, LlvmStatement) +castVar v t | getVarType v == t + = return (v, Nop) + + | otherwise + = let op = case (getVarType v, t) of + (LMInt n, LMInt m) + -> if n < m then LM_Sext else LM_Trunc + (vt, _) | isFloat vt && isFloat t + -> if llvmWidthInBits vt < llvmWidthInBits t + then LM_Fpext else LM_Fptrunc + (vt, _) | isInt vt && isFloat t -> LM_Sitofp + (vt, _) | isFloat vt && isInt t -> LM_Fptosi + (vt, _) | isInt vt && isPointer t -> LM_Inttoptr + (vt, _) | isPointer vt && isInt t -> LM_Ptrtoint + (vt, _) | isPointer vt && isPointer t -> LM_Bitcast + + (vt, _) -> panic $ "castVars: Can't cast this type (" + ++ show vt ++ ") to (" ++ show t ++ ")" + in doExpr t $ Cast op v t + + -- | Decide what C function to use to implement a CallishMachOp -cmmPrimOpFunctions :: CallishMachOp -> FastString -cmmPrimOpFunctions mop +cmmPrimOpFunctions :: LlvmEnv -> CallishMachOp -> LMString +cmmPrimOpFunctions env mop = case mop of MO_F32_Exp -> fsLit "expf" MO_F32_Log -> fsLit "logf" @@ -408,8 +441,18 @@ cmmPrimOpFunctions mop MO_F64_Cosh -> fsLit "cosh" MO_F64_Tanh -> fsLit "tanh" + MO_Memcpy -> fsLit $ "llvm.memcpy." ++ intrinTy1 + MO_Memmove -> fsLit $ "llvm.memmove." ++ intrinTy1 + MO_Memset -> fsLit $ "llvm.memset." ++ intrinTy2 + a -> panic $ "cmmPrimOpFunctions: Unknown callish op! (" ++ show a ++ ")" + where + intrinTy1 = (if getLlvmVer env >= 28 + then "p0i8.p0i8." else "") ++ show llvmWord + intrinTy2 = (if getLlvmVer env >= 28 + then "p0i8." else "") ++ show llvmWord + -- | Tail function calls genJump :: LlvmEnv -> CmmExpr -> UniqSM StmtData @@ -594,7 +637,7 @@ genSwitch env cond maybe_ids = do (env', vc, stmts, top) <- exprToVar env cond let ty = getVarType vc - let pairs = [ (ix, id) | (ix,Just id) <- zip ([0..]::[Integer]) maybe_ids ] + let pairs = [ (ix, id) | (ix,Just id) <- zip [0..] maybe_ids ] let labels = map (\(ix, b) -> (mkIntLit ty ix, blockIdToLlvm b)) pairs -- out of range is undefied, so lets just branch to first label let (_, defLbl) = head labels @@ -675,11 +718,11 @@ genMachOp :: LlvmEnv -> EOption -> MachOp -> [CmmExpr] -> UniqSM ExprData genMachOp env _ op [x] = case op of MO_Not w -> - let all1 = mkIntLit (widthToLlvmInt w) (-1::Int) + let all1 = mkIntLit (widthToLlvmInt w) (-1) in negate (widthToLlvmInt w) all1 LM_MO_Xor MO_S_Neg w -> - let all0 = mkIntLit (widthToLlvmInt w) (0::Int) + let all0 = mkIntLit (widthToLlvmInt w) 0 in negate (widthToLlvmInt w) all0 LM_MO_Sub MO_F_Neg w -> @@ -1107,6 +1150,28 @@ funEpilogue = do return (vars, concatOL stmts) +-- | A serries of statements to trash all the STG registers. +-- +-- In LLVM we pass the STG registers around everywhere in function calls. +-- So this means LLVM considers them live across the entire function, when +-- in reality they usually aren't. For Caller save registers across C calls +-- the saving and restoring of them is done by the Cmm code generator, +-- using Cmm local vars. So to stop LLVM saving them as well (and saving +-- all of them since it thinks they're always live, we trash them just +-- before the call by assigning the 'undef' value to them. The ones we +-- need are restored from the Cmm local var and the ones we don't need +-- are fine to be trashed. +trashStmts :: LlvmStatements +trashStmts = concatOL $ map trashReg activeStgRegs + where trashReg r = + let reg = lmGlobalRegVar r + ty = (pLower . getVarType) reg + trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg + in case callerSaves r of + True -> trash + False -> nilOL + + -- | Get a function pointer to the CLabel specified. -- -- This is for Haskell functions, function type is assumed, so doesn't work diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index f5e3394..b58b7cd 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -13,12 +13,6 @@ import LlvmCodeGen ( llvmCodeGen ) import UniqSupply ( mkSplitUniqSupply ) -#ifdef JAVA -import JavaGen ( javaGen ) -import qualified PrintJava -import OccurAnal ( occurAnalyseBinds ) -#endif - import Finder ( mkStubPaths ) import PprC ( writeCs ) import CmmLint ( cmmLint ) @@ -83,12 +77,6 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC HscAsm -> outputAsm dflags filenm flat_abstractC; HscC -> outputC dflags filenm flat_abstractC pkg_deps; HscLlvm -> outputLlvm dflags filenm flat_abstractC; - HscJava -> -#ifdef JAVA - outputJava dflags filenm mod_name tycons core_binds; -#else - panic "Java support not compiled into this ghc"; -#endif HscNothing -> panic "codeOutput: HscNothing" } ; return stubs_exist @@ -176,26 +164,6 @@ outputLlvm dflags filenm flat_absC %************************************************************************ %* * -\subsection{Java} -%* * -%************************************************************************ - -\begin{code} -#ifdef JAVA -outputJava dflags filenm mod tycons core_binds - = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java) - -- User style printing for now to keep indentation - where - occ_anal_binds = occurAnalyseBinds core_binds - -- Make sure we have up to date dead-var information - java_code = javaGen mod [{- Should be imports-}] tycons occ_anal_binds - pp_java = PrintJava.compilationUnit java_code -#endif -\end{code} - - -%************************************************************************ -%* * \subsection{Foreign import/export} %* * %************************************************************************ diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 2719470..afbd03e 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2007,5 +2007,4 @@ hscNextPhase dflags _ hsc_lang = HscLlvm -> LlvmOpt HscNothing -> StopLn HscInterpreted -> StopLn - _other -> StopLn diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index d9f3246..b49b860 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -644,7 +644,6 @@ data HscTarget = HscC -- ^ Generate C code. | HscAsm -- ^ Generate assembly using the native code generator. | HscLlvm -- ^ Generate assembly using the llvm code generator. - | HscJava -- ^ Generate Java bytecode. | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory') | HscNothing -- ^ Don't generate any code. See notes above. deriving (Eq, Show) @@ -653,7 +652,6 @@ showHscTargetFlag :: HscTarget -> String showHscTargetFlag HscC = "-fvia-c" showHscTargetFlag HscAsm = "-fasm" showHscTargetFlag HscLlvm = "-fllvm" -showHscTargetFlag HscJava = panic "No flag for HscJava" showHscTargetFlag HscInterpreted = "-fbyte-code" showHscTargetFlag HscNothing = "-fno-code" diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 1c7a389..a0a9f0e 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -190,11 +190,11 @@ dumpIfSet_dyn dflags flag hdr doc = return () dumpIfSet_dyn_or :: DynFlags -> [DynFlag] -> String -> SDoc -> IO () -dumpIfSet_dyn_or dflags flags hdr doc - | or [dopt flag dflags | flag <- flags] - || verbosity dflags >= 4 - = printDump (mkDumpDoc hdr doc) - | otherwise = return () +dumpIfSet_dyn_or _ [] _ _ = return () +dumpIfSet_dyn_or dflags (flag : flags) hdr doc + = if dopt flag dflags || verbosity dflags >= 4 + then dumpSDoc dflags flag hdr doc + else dumpIfSet_dyn_or dflags flags hdr doc mkDumpDoc :: String -> SDoc -> SDoc mkDumpDoc hdr doc diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 6a5552f..3e37f5b 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -430,7 +430,7 @@ makeSimpleDetails hsc_env tc_result = mkBootModDetailsTc hsc_env tc_result It's the task of the compilation proper to compile Haskell, hs-boot and -core files to either byte-code, hard-code (C, asm, Java, ect) or to +core files to either byte-code, hard-code (C, asm, LLVM, ect) or to nothing at all (the module is still parsed and type-checked. This feature is mostly used by IDE's and the likes). Compilation can happen in either 'one-shot', 'batch', 'nothing', diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 77e69fd..f3e569b 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -100,7 +100,7 @@ module HscTypes ( #include "HsVersions.h" #ifdef GHCI -import ByteCodeAsm ( CompiledByteCode ) +import ByteCodeAsm ( CompiledByteCode ) import {-# SOURCE #-} InteractiveEval ( Resume ) #endif @@ -108,16 +108,17 @@ import HsSyn import RdrName import Name import NameEnv -import NameSet +import NameSet import Module -import InstEnv ( InstEnv, Instance ) -import FamInstEnv ( FamInstEnv, FamInst ) -import Rules ( RuleBase ) -import CoreSyn ( CoreBind ) +import InstEnv ( InstEnv, Instance ) +import FamInstEnv ( FamInstEnv, FamInst ) +import Rules ( RuleBase ) +import CoreSyn ( CoreBind ) import VarEnv +import VarSet import Var import Id -import Type +import Type import Annotations import Class ( Class, classAllSelIds, classATs, classTyCon ) @@ -1722,9 +1723,9 @@ isHpcUsed (NoHpcInfo { hpcUsed = used }) = used \end{code} %************************************************************************ -%* * +%* * \subsection{Vectorisation Support} -%* * +%* * %************************************************************************ The following information is generated and consumed by the vectorisation @@ -1737,49 +1738,58 @@ vectorisation, we need to know `f_v', whose `Var' we cannot lookup based on just the OccName easily in a Core pass. \begin{code} --- | Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'. +-- |Vectorisation information for 'ModGuts', 'ModDetails' and 'ExternalPackageState'; see also +-- documentation at 'Vectorise.Env.GlobalEnv'. data VectInfo - = VectInfo { - vectInfoVar :: VarEnv (Var , Var ), -- ^ @(f, f_v)@ keyed on @f@ - vectInfoTyCon :: NameEnv (TyCon , TyCon), -- ^ @(T, T_v)@ keyed on @T@ - vectInfoDataCon :: NameEnv (DataCon, DataCon), -- ^ @(C, C_v)@ keyed on @C@ - vectInfoPADFun :: NameEnv (TyCon , Var), -- ^ @(T_v, paT)@ keyed on @T_v@ - vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@ + = VectInfo + { vectInfoVar :: VarEnv (Var , Var ) -- ^ @(f, f_v)@ keyed on @f@ + , vectInfoTyCon :: NameEnv (TyCon , TyCon) -- ^ @(T, T_v)@ keyed on @T@ + , vectInfoDataCon :: NameEnv (DataCon, DataCon) -- ^ @(C, C_v)@ keyed on @C@ + , vectInfoPADFun :: NameEnv (TyCon , Var) -- ^ @(T_v, paT)@ keyed on @T_v@ + , vectInfoIso :: NameEnv (TyCon , Var) -- ^ @(T, isoT)@ keyed on @T@ + , vectInfoScalarVars :: VarSet -- ^ set of purely scalar variables + , vectInfoScalarTyCons :: NameSet -- ^ set of scalar type constructors } --- | Vectorisation information for 'ModIface': a slightly less low-level view +-- |Vectorisation information for 'ModIface'; i.e, the vectorisation information propagated +-- across module boundaries. +-- data IfaceVectInfo - = IfaceVectInfo { - ifaceVectInfoVar :: [Name], - -- ^ All variables in here have a vectorised variant - ifaceVectInfoTyCon :: [Name], - -- ^ All 'TyCon's in here have a vectorised variant; - -- the name of the vectorised variant and those of its - -- data constructors are determined by 'OccName.mkVectTyConOcc' - -- and 'OccName.mkVectDataConOcc'; the names of - -- the isomorphisms are determined by 'OccName.mkVectIsoOcc' - ifaceVectInfoTyConReuse :: [Name] - -- ^ The vectorised form of all the 'TyCon's in here coincides with - -- the unconverted form; the name of the isomorphisms is determined - -- by 'OccName.mkVectIsoOcc' + = IfaceVectInfo + { ifaceVectInfoVar :: [Name] -- ^ All variables in here have a vectorised variant + , ifaceVectInfoTyCon :: [Name] -- ^ All 'TyCon's in here have a vectorised variant; + -- the name of the vectorised variant and those of its + -- data constructors are determined by + -- 'OccName.mkVectTyConOcc' and + -- 'OccName.mkVectDataConOcc'; the names of the + -- isomorphisms are determined by 'OccName.mkVectIsoOcc' + , ifaceVectInfoTyConReuse :: [Name] -- ^ The vectorised form of all the 'TyCon's in here + -- coincides with the unconverted form; the name of the + -- isomorphisms is determined by 'OccName.mkVectIsoOcc' + , ifaceVectInfoScalarVars :: [Name] -- iface version of 'vectInfoScalarVar' + , ifaceVectInfoScalarTyCons :: [Name] -- iface version of 'vectInfoScalarTyCon' } noVectInfo :: VectInfo -noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv +noVectInfo + = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyVarSet + emptyNameSet plusVectInfo :: VectInfo -> VectInfo -> VectInfo plusVectInfo vi1 vi2 = - VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) - (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) - (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) - (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2) - (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) + VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) + (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) + (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) + (vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2) + (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) + (vectInfoScalarVars vi1 `unionVarSet` vectInfoScalarVars vi2) + (vectInfoScalarTyCons vi1 `unionNameSets` vectInfoScalarTyCons vi2) concatVectInfo :: [VectInfo] -> VectInfo concatVectInfo = foldr plusVectInfo noVectInfo noIfaceVectInfo :: IfaceVectInfo -noIfaceVectInfo = IfaceVectInfo [] [] [] +noIfaceVectInfo = IfaceVectInfo [] [] [] [] [] \end{code} %************************************************************************ diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 9c086cc..e40312c 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -21,6 +21,7 @@ module SysTools ( runWindres, runLlvmOpt, runLlvmLlc, + figureLlvmVersion, readElfSection, touch, -- String -> String -> IO () @@ -416,16 +417,54 @@ runAs dflags args = do mb_env <- getGccEnv args1 runSomethingFiltered dflags id "Assembler" p args1 mb_env +-- | Run the LLVM Optimiser runLlvmOpt :: DynFlags -> [Option] -> IO () runLlvmOpt dflags args = do let (p,args0) = pgm_lo dflags runSomething dflags "LLVM Optimiser" p (args0++args) +-- | Run the LLVM Compiler runLlvmLlc :: DynFlags -> [Option] -> IO () runLlvmLlc dflags args = do let (p,args0) = pgm_lc dflags runSomething dflags "LLVM Compiler" p (args0++args) +-- | Figure out which version of LLVM we are running this session +figureLlvmVersion :: DynFlags -> IO (Maybe Int) +figureLlvmVersion dflags = do + let (pgm,opts) = pgm_lc dflags + args = filter notNull (map showOpt opts) + -- we grab the args even though they should be useless just in + -- case the user is using a customised 'llc' that requires some + -- of the options they've specified. llc doesn't care what other + -- options are specified when '-version' is used. + args' = args ++ ["-version"] + ver <- catchIO (do + (pin, pout, perr, _) <- runInteractiveProcess pgm args' + Nothing Nothing + {- > llc -version + Low Level Virtual Machine (http://llvm.org/): + llvm version 2.8 (Ubuntu 2.8-0Ubuntu1) + ... + -} + hSetBinaryMode pout False + _ <- hGetLine pout + vline <- hGetLine pout + v <- case filter isDigit vline of + [] -> fail "no digits!" + [x] -> fail $ "only 1 digit! (" ++ show x ++ ")" + (x:y:_) -> return ((read [x,y]) :: Int) + hClose pin + hClose pout + hClose perr + return $ Just v + ) + (\err -> do + putMsg dflags $ text $ "Warning: " ++ show err + return Nothing) + return ver + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = do let (p,args0) = pgm_l dflags diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index b4296cb..b3f1a06 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -487,12 +487,16 @@ tidyInstances tidy_dfun ispecs \begin{code} tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo -tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars - , vectInfoPADFun = pas - , vectInfoIso = isos }) - = info { vectInfoVar = tidy_vars - , vectInfoPADFun = tidy_pas - , vectInfoIso = tidy_isos } +tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars + , vectInfoPADFun = pas + , vectInfoIso = isos + , vectInfoScalarVars = scalarVars + }) + = info { vectInfoVar = tidy_vars + , vectInfoPADFun = tidy_pas + , vectInfoIso = tidy_isos + , vectInfoScalarVars = tidy_scalarVars + } where tidy_vars = mkVarEnv $ map tidy_var_mapping @@ -504,6 +508,10 @@ tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar = vars tidy_var_mapping (from, to) = (from', (from', lookup_var to)) where from' = lookup_var from tidy_snd_var (x, var) = (x, lookup_var var) + + tidy_scalarVars = mkVarSet + $ map lookup_var + $ varSetElems scalarVars lookup_var var = lookupWithDefaultVarEnv var_env var var \end{code} diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index 57faa6f..ae91b62 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -13,32 +13,24 @@ module AsmCodeGen ( nativeCodeGen ) where #include "nativeGen/NCG.h" -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -import X86.CodeGen -import X86.Regs -import X86.Instr -import X86.Ppr - -#elif sparc_TARGET_ARCH -import SPARC.CodeGen -import SPARC.CodeGen.Expand -import SPARC.Regs -import SPARC.Instr -import SPARC.Ppr -import SPARC.ShortcutJump - -#elif powerpc_TARGET_ARCH -import PPC.CodeGen -import PPC.Cond -import PPC.Regs -import PPC.RegInfo -import PPC.Instr -import PPC.Ppr - -#else -#error "AsmCodeGen: unknown architecture" - -#endif +import qualified X86.CodeGen +import qualified X86.Regs +import qualified X86.Instr +import qualified X86.Ppr + +import qualified SPARC.CodeGen +import qualified SPARC.Regs +import qualified SPARC.Instr +import qualified SPARC.Ppr +import qualified SPARC.ShortcutJump +import qualified SPARC.CodeGen.Expand + +import qualified PPC.CodeGen +import qualified PPC.Cond +import qualified PPC.Regs +import qualified PPC.RegInfo +import qualified PPC.Instr +import qualified PPC.Ppr import RegAlloc.Liveness import qualified RegAlloc.Linear.Main as Linear @@ -71,6 +63,7 @@ import StaticFlags import Util import Digraph +import Pretty (Doc) import qualified Pretty import BufWrite import Outputable @@ -138,17 +131,89 @@ The machine-dependent bits break down as follows: -- ----------------------------------------------------------------------------- -- Top-level of the native codegen +data NcgImpl instr jumpDest = NcgImpl { + cmmTopCodeGen :: DynFlags -> RawCmmTop -> NatM [NatCmmTop instr], + generateJumpTableForInstr :: instr -> Maybe (NatCmmTop instr), + getJumpDestBlockId :: jumpDest -> Maybe BlockId, + canShortcut :: instr -> Maybe jumpDest, + shortcutStatic :: (BlockId -> Maybe jumpDest) -> CmmStatic -> CmmStatic, + shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr, + pprNatCmmTop :: NatCmmTop instr -> Doc, + maxSpillSlots :: Int, + allocatableRegs :: [RealReg], + ncg_x86fp_kludge :: [NatCmmTop instr] -> [NatCmmTop instr], + ncgExpandTop :: [NatCmmTop instr] -> [NatCmmTop instr], + ncgMakeFarBranches :: [NatBasicBlock instr] -> [NatBasicBlock instr] + } + -------------------- nativeCodeGen :: DynFlags -> Handle -> UniqSupply -> [RawCmm] -> IO () nativeCodeGen dflags h us cmms + = let nCG' ncgImpl = nativeCodeGen' dflags ncgImpl h us cmms + x86NcgImpl = NcgImpl { + cmmTopCodeGen = X86.CodeGen.cmmTopCodeGen + ,generateJumpTableForInstr = X86.CodeGen.generateJumpTableForInstr + ,getJumpDestBlockId = X86.Instr.getJumpDestBlockId + ,canShortcut = X86.Instr.canShortcut + ,shortcutStatic = X86.Instr.shortcutStatic + ,shortcutJump = X86.Instr.shortcutJump + ,pprNatCmmTop = X86.Ppr.pprNatCmmTop + ,maxSpillSlots = X86.Instr.maxSpillSlots + ,allocatableRegs = X86.Regs.allocatableRegs + ,ncg_x86fp_kludge = id + ,ncgExpandTop = id + ,ncgMakeFarBranches = id + } + in case platformArch $ targetPlatform dflags of + ArchX86 -> nCG' (x86NcgImpl { ncg_x86fp_kludge = map x86fp_kludge }) + ArchX86_64 -> nCG' x86NcgImpl + ArchPPC -> + nCG' $ NcgImpl { + cmmTopCodeGen = PPC.CodeGen.cmmTopCodeGen + ,generateJumpTableForInstr = PPC.CodeGen.generateJumpTableForInstr + ,getJumpDestBlockId = PPC.RegInfo.getJumpDestBlockId + ,canShortcut = PPC.RegInfo.canShortcut + ,shortcutStatic = PPC.RegInfo.shortcutStatic + ,shortcutJump = PPC.RegInfo.shortcutJump + ,pprNatCmmTop = PPC.Ppr.pprNatCmmTop + ,maxSpillSlots = PPC.Instr.maxSpillSlots + ,allocatableRegs = PPC.Regs.allocatableRegs + ,ncg_x86fp_kludge = id + ,ncgExpandTop = id + ,ncgMakeFarBranches = makeFarBranches + } + ArchSPARC -> + nCG' $ NcgImpl { + cmmTopCodeGen = SPARC.CodeGen.cmmTopCodeGen + ,generateJumpTableForInstr = SPARC.CodeGen.generateJumpTableForInstr + ,getJumpDestBlockId = SPARC.ShortcutJump.getJumpDestBlockId + ,canShortcut = SPARC.ShortcutJump.canShortcut + ,shortcutStatic = SPARC.ShortcutJump.shortcutStatic + ,shortcutJump = SPARC.ShortcutJump.shortcutJump + ,pprNatCmmTop = SPARC.Ppr.pprNatCmmTop + ,maxSpillSlots = SPARC.Instr.maxSpillSlots + ,allocatableRegs = SPARC.Regs.allocatableRegs + ,ncg_x86fp_kludge = id + ,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop + ,ncgMakeFarBranches = id + } + ArchPPC_64 -> + panic "nativeCodeGen: No NCG for PPC 64" + ArchUnknown -> + panic "nativeCodeGen: No NCG for unknown arch" + +nativeCodeGen' :: (Instruction instr, Outputable instr) + => DynFlags + -> NcgImpl instr jumpDest + -> Handle -> UniqSupply -> [RawCmm] -> IO () +nativeCodeGen' dflags ncgImpl h us cmms = do let split_cmms = concat $ map add_split cmms - -- BufHandle is a performance hack. We could hide it inside -- Pretty if it weren't for the fact that we do lots of little -- printDocs here (in order to do codegen in constant space). bufh <- newBufHandle h - (imports, prof) <- cmmNativeGens dflags bufh us split_cmms [] [] 0 + (imports, prof) <- cmmNativeGens dflags ncgImpl bufh us split_cmms [] [] 0 bFlush bufh let (native, colorStats, linearStats) @@ -157,7 +222,7 @@ nativeCodeGen dflags h us cmms -- dump native code dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" - (vcat $ map (docToSDoc . pprNatCmmTop) $ concat native) + (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl) $ concat native) -- dump global NCG stats for graph coloring allocator (case concat $ catMaybes colorStats of @@ -203,30 +268,32 @@ nativeCodeGen dflags h us cmms -- | Do native code generation on all these cmms. -- -cmmNativeGens :: DynFlags +cmmNativeGens :: (Instruction instr, Outputable instr) + => DynFlags + -> NcgImpl instr jumpDest -> BufHandle -> UniqSupply -> [RawCmmTop] -> [[CLabel]] - -> [ ([NatCmmTop Instr], - Maybe [Color.RegAllocStats Instr], + -> [ ([NatCmmTop instr], + Maybe [Color.RegAllocStats instr], Maybe [Linear.RegAllocStats]) ] -> Int -> IO ( [[CLabel]], - [([NatCmmTop Instr], - Maybe [Color.RegAllocStats Instr], + [([NatCmmTop instr], + Maybe [Color.RegAllocStats instr], Maybe [Linear.RegAllocStats])] ) -cmmNativeGens _ _ _ [] impAcc profAcc _ +cmmNativeGens _ _ _ _ [] impAcc profAcc _ = return (reverse impAcc, reverse profAcc) -cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc count +cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count = do (us', native, imports, colorStats, linearStats) - <- cmmNativeGen dflags us cmm count + <- cmmNativeGen dflags ncgImpl us cmm count Pretty.bufLeftRender h - $ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map pprNatCmmTop native + $ {-# SCC "pprNativeCode" #-} Pretty.vcat $ map (pprNatCmmTop ncgImpl) native -- carefully evaluate this strictly. Binding it with 'let' -- and then using 'seq' doesn't work, because the let @@ -242,7 +309,8 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc count -- force evaulation all this stuff to avoid space leaks seqString (showSDoc $ vcat $ map ppr imports) `seq` return () - cmmNativeGens dflags h us' cmms + cmmNativeGens dflags ncgImpl + h us' cmms (imports : impAcc) ((lsPprNative, colorStats, linearStats) : profAcc) count' @@ -254,18 +322,20 @@ cmmNativeGens dflags h us (cmm : cmms) impAcc profAcc count -- | Complete native code generation phase for a single top-level chunk of Cmm. -- Dumping the output of each stage along the way. -- Global conflict graph and NGC stats -cmmNativeGen - :: DynFlags +cmmNativeGen + :: (Instruction instr, Outputable instr) + => DynFlags + -> NcgImpl instr jumpDest -> UniqSupply -> RawCmmTop -- ^ the cmm to generate code for -> Int -- ^ sequence number of this top thing -> IO ( UniqSupply - , [NatCmmTop Instr] -- native code + , [NatCmmTop instr] -- native code , [CLabel] -- things imported by this cmm - , Maybe [Color.RegAllocStats Instr] -- stats for the coloring register allocator + , Maybe [Color.RegAllocStats instr] -- stats for the coloring register allocator , Maybe [Linear.RegAllocStats]) -- stats for the linear register allocators -cmmNativeGen dflags us cmm count +cmmNativeGen dflags ncgImpl us cmm count = do -- rewrite assignments to global regs @@ -285,11 +355,11 @@ cmmNativeGen dflags us cmm count -- generate native code from cmm let ((native, lastMinuteImports), usGen) = {-# SCC "genMachCode" #-} - initUs us $ genMachCode dflags opt_cmm + initUs us $ genMachCode dflags (cmmTopCodeGen ncgImpl) opt_cmm dumpIfSet_dyn dflags Opt_D_dump_asm_native "Native code" - (vcat $ map (docToSDoc . pprNatCmmTop) native) + (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl) native) -- tag instructions with register liveness information let (withLiveness, usLive) = @@ -312,7 +382,7 @@ cmmNativeGen dflags us cmm count = foldr (\r -> plusUFM_C unionUniqSets $ unitUFM (targetClassOfRealReg r) (unitUniqSet r)) emptyUFM - $ allocatableRegs + $ allocatableRegs ncgImpl -- do the graph coloring register allocation let ((alloced, regAllocStats), usAlloc) @@ -321,13 +391,13 @@ cmmNativeGen dflags us cmm count $ Color.regAlloc dflags alloc_regs - (mkUniqSet [0..maxSpillSlots]) + (mkUniqSet [0 .. maxSpillSlots ncgImpl]) withLiveness -- dump out what happened during register allocation dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc "Registers allocated" - (vcat $ map (docToSDoc . pprNatCmmTop) alloced) + (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl) alloced) dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc_stages "Build/spill stages" @@ -354,11 +424,11 @@ cmmNativeGen dflags us cmm count = {-# SCC "RegAlloc" #-} initUs usLive $ liftM unzip - $ mapUs Linear.regAlloc withLiveness + $ mapUs (Linear.regAlloc dflags) withLiveness dumpIfSet_dyn dflags Opt_D_dump_asm_regalloc "Registers allocated" - (vcat $ map (docToSDoc . pprNatCmmTop) alloced) + (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl) alloced) let mPprStats = if dopt Opt_D_dump_asm_stats dflags @@ -378,42 +448,31 @@ cmmNativeGen dflags us cmm count ---- ---- NB. must happen before shortcutBranches, because that ---- generates JXX_GBLs which we can't fix up in x86fp_kludge. - let kludged = -#if i386_TARGET_ARCH - {-# SCC "x86fp_kludge" #-} - map x86fp_kludge alloced -#else - alloced -#endif + let kludged = {-# SCC "x86fp_kludge" #-} ncg_x86fp_kludge ncgImpl alloced ---- generate jump tables let tabled = {-# SCC "generateJumpTables" #-} - generateJumpTables kludged + generateJumpTables ncgImpl kludged ---- shortcut branches let shorted = {-# SCC "shortcutBranches" #-} - shortcutBranches dflags tabled + shortcutBranches dflags ncgImpl tabled ---- sequence blocks let sequenced = {-# SCC "sequenceBlocks" #-} - map sequenceTop shorted + map (sequenceTop ncgImpl) shorted ---- expansion of SPARC synthetic instrs -#if sparc_TARGET_ARCH let expanded = {-# SCC "sparc_expand" #-} - map expandTop sequenced + ncgExpandTop ncgImpl sequenced dumpIfSet_dyn dflags Opt_D_dump_asm_expanded "Synthetic instructions expanded" - (vcat $ map (docToSDoc . pprNatCmmTop) expanded) -#else - let expanded = - sequenced -#endif + (vcat $ map (docToSDoc . pprNatCmmTop ncgImpl) expanded) return ( usAlloc , expanded @@ -422,12 +481,10 @@ cmmNativeGen dflags us cmm count , ppr_raStatsLinear) -#if i386_TARGET_ARCH -x86fp_kludge :: NatCmmTop Instr -> NatCmmTop Instr +x86fp_kludge :: NatCmmTop X86.Instr.Instr -> NatCmmTop X86.Instr.Instr x86fp_kludge top@(CmmData _ _) = top x86fp_kludge (CmmProc info lbl (ListGraph code)) = - CmmProc info lbl (ListGraph $ i386_insert_ffrees code) -#endif + CmmProc info lbl (ListGraph $ X86.Instr.i386_insert_ffrees code) -- | Build a doc for all the imports. @@ -496,12 +553,12 @@ makeImportsDoc dflags imports -- fallthroughs. sequenceTop - :: NatCmmTop Instr - -> NatCmmTop Instr + :: Instruction instr + => NcgImpl instr jumpDest -> NatCmmTop instr -> NatCmmTop instr -sequenceTop top@(CmmData _ _) = top -sequenceTop (CmmProc info lbl (ListGraph blocks)) = - CmmProc info lbl (ListGraph $ makeFarBranches $ sequenceBlocks blocks) +sequenceTop _ top@(CmmData _ _) = top +sequenceTop ncgImpl (CmmProc info lbl (ListGraph blocks)) = + CmmProc info lbl (ListGraph $ ncgMakeFarBranches ncgImpl $ sequenceBlocks blocks) -- The algorithm is very simple (and stupid): we make a graph out of -- the blocks where there is an edge from one block to another iff the @@ -575,11 +632,9 @@ reorder id accum (b@(block,id',out) : rest) -- Conditional branches on PowerPC are limited to +-32KB; if our Procs get too -- big, we have to work around this limitation. -makeFarBranches - :: [NatBasicBlock Instr] - -> [NatBasicBlock Instr] - -#if powerpc_TARGET_ARCH +makeFarBranches + :: [NatBasicBlock PPC.Instr.Instr] + -> [NatBasicBlock PPC.Instr.Instr] makeFarBranches blocks | last blockAddresses < nearLimit = blocks | otherwise = zipWith handleBlock blockAddresses blocks @@ -590,12 +645,12 @@ makeFarBranches blocks handleBlock addr (BasicBlock id instrs) = BasicBlock id (zipWith makeFar [addr..] instrs) - makeFar _ (BCC ALWAYS tgt) = BCC ALWAYS tgt - makeFar addr (BCC cond tgt) + makeFar _ (PPC.Instr.BCC PPC.Cond.ALWAYS tgt) = PPC.Instr.BCC PPC.Cond.ALWAYS tgt + makeFar addr (PPC.Instr.BCC cond tgt) | abs (addr - targetAddr) >= nearLimit - = BCCFAR cond tgt + = PPC.Instr.BCCFAR cond tgt | otherwise - = BCC cond tgt + = PPC.Instr.BCC cond tgt where Just targetAddr = lookupUFM blockAddressMap tgt makeFar _ other = other @@ -606,9 +661,6 @@ makeFarBranches blocks -- things exactly blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses -#else -makeFarBranches = id -#endif -- ----------------------------------------------------------------------------- -- Generate jump tables @@ -616,33 +668,36 @@ makeFarBranches = id -- Analyzes all native code and generates data sections for all jump -- table instructions. generateJumpTables - :: [NatCmmTop Instr] -> [NatCmmTop Instr] -generateJumpTables xs = concatMap f xs + :: NcgImpl instr jumpDest + -> [NatCmmTop instr] -> [NatCmmTop instr] +generateJumpTables ncgImpl xs = concatMap f xs where f p@(CmmProc _ _ (ListGraph xs)) = p : concatMap g xs f p = [p] - g (BasicBlock _ xs) = catMaybes (map generateJumpTableForInstr xs) + g (BasicBlock _ xs) = catMaybes (map (generateJumpTableForInstr ncgImpl) xs) -- ----------------------------------------------------------------------------- -- Shortcut branches -shortcutBranches - :: DynFlags - -> [NatCmmTop Instr] - -> [NatCmmTop Instr] +shortcutBranches + :: DynFlags + -> NcgImpl instr jumpDest + -> [NatCmmTop instr] + -> [NatCmmTop instr] -shortcutBranches dflags tops +shortcutBranches dflags ncgImpl tops | optLevel dflags < 1 = tops -- only with -O or higher - | otherwise = map (apply_mapping mapping) tops' + | otherwise = map (apply_mapping ncgImpl mapping) tops' where - (tops', mappings) = mapAndUnzip build_mapping tops + (tops', mappings) = mapAndUnzip (build_mapping ncgImpl) tops mapping = foldr plusUFM emptyUFM mappings -build_mapping :: GenCmmTop d t (ListGraph Instr) - -> (GenCmmTop d t (ListGraph Instr), UniqFM JumpDest) -build_mapping top@(CmmData _ _) = (top, emptyUFM) -build_mapping (CmmProc info lbl (ListGraph [])) +build_mapping :: NcgImpl instr jumpDest + -> GenCmmTop d t (ListGraph instr) + -> (GenCmmTop d t (ListGraph instr), UniqFM jumpDest) +build_mapping _ top@(CmmData _ _) = (top, emptyUFM) +build_mapping _ (CmmProc info lbl (ListGraph [])) = (CmmProc info lbl (ListGraph []), emptyUFM) -build_mapping (CmmProc info lbl (ListGraph (head:blocks))) +build_mapping ncgImpl (CmmProc info lbl (ListGraph (head:blocks))) = (CmmProc info lbl (ListGraph (head:others)), mapping) -- drop the shorted blocks, but don't ever drop the first one, -- because it is pointed to by a global label. @@ -652,11 +707,12 @@ build_mapping (CmmProc info lbl (ListGraph (head:blocks))) -- Don't completely eliminate loops here -- that can leave a dangling jump! (_, shortcut_blocks, others) = foldl split (emptyBlockSet, [], []) blocks split (s, shortcut_blocks, others) b@(BasicBlock id [insn]) - | Just (DestBlockId dest) <- canShortcut insn, + | Just jd <- canShortcut ncgImpl insn, + Just dest <- getJumpDestBlockId ncgImpl jd, (setMember dest s) || dest == id -- loop checks = (s, shortcut_blocks, b : others) split (s, shortcut_blocks, others) (BasicBlock id [insn]) - | Just dest <- canShortcut insn + | Just dest <- canShortcut ncgImpl insn = (setInsert id s, (id,dest) : shortcut_blocks, others) split (s, shortcut_blocks, others) other = (s, shortcut_blocks, other : others) @@ -665,18 +721,19 @@ build_mapping (CmmProc info lbl (ListGraph (head:blocks))) mapping = foldl add emptyUFM shortcut_blocks add ufm (id,dest) = addToUFM ufm id dest -apply_mapping :: UniqFM JumpDest - -> GenCmmTop CmmStatic h (ListGraph Instr) - -> GenCmmTop CmmStatic h (ListGraph Instr) -apply_mapping ufm (CmmData sec statics) - = CmmData sec (map (shortcutStatic (lookupUFM ufm)) statics) +apply_mapping :: NcgImpl instr jumpDest + -> UniqFM jumpDest + -> GenCmmTop CmmStatic h (ListGraph instr) + -> GenCmmTop CmmStatic h (ListGraph instr) +apply_mapping ncgImpl ufm (CmmData sec statics) + = CmmData sec (map (shortcutStatic ncgImpl (lookupUFM ufm)) statics) -- we need to get the jump tables, so apply the mapping to the entries -- of a CmmData too. -apply_mapping ufm (CmmProc info lbl (ListGraph blocks)) +apply_mapping ncgImpl ufm (CmmProc info lbl (ListGraph blocks)) = CmmProc info lbl (ListGraph $ map short_bb blocks) where short_bb (BasicBlock id insns) = BasicBlock id $! map short_insn insns - short_insn i = shortcutJump (lookupUFM ufm) i + short_insn i = shortcutJump ncgImpl (lookupUFM ufm) i -- shortcutJump should apply the mapping repeatedly, -- just in case we can short multiple branches. @@ -702,12 +759,13 @@ apply_mapping ufm (CmmProc info lbl (ListGraph blocks)) genMachCode :: DynFlags + -> (DynFlags -> RawCmmTop -> NatM [NatCmmTop instr]) -> RawCmmTop -> UniqSM - ( [NatCmmTop Instr] + ( [NatCmmTop instr] , [CLabel]) -genMachCode dflags cmm_top +genMachCode dflags cmmTopCodeGen cmm_top = do { initial_us <- getUs ; let initial_st = mkNatM_State initial_us 0 dflags (new_tops, final_st) = initNat initial_st (cmmTopCodeGen dflags cmm_top) diff --git a/compiler/nativeGen/NCG.h b/compiler/nativeGen/NCG.h index 6771b75..81cbf61 100644 --- a/compiler/nativeGen/NCG.h +++ b/compiler/nativeGen/NCG.h @@ -14,97 +14,18 @@ #define COMMA , -- - - - - - - - - - - - - - - - - - - - - - -#if alpha_TARGET_ARCH -# define IF_ARCH_alpha(x,y) x -#else -# define IF_ARCH_alpha(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - #if i386_TARGET_ARCH # define IF_ARCH_i386(x,y) x #else # define IF_ARCH_i386(x,y) y #endif -- - - - - - - - - - - - - - - - - - - - - - -#if x86_64_TARGET_ARCH -# define IF_ARCH_x86_64(x,y) x -#else -# define IF_ARCH_x86_64(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if freebsd_TARGET_OS -# define IF_OS_freebsd(x,y) x -#else -# define IF_OS_freebsd(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if dragonfly_TARGET_OS -# define IF_OS_dragonfly(x,y) x -#else -# define IF_OS_dragonfly(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if netbsd_TARGET_OS -# define IF_OS_netbsd(x,y) x -#else -# define IF_OS_netbsd(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if openbsd_TARGET_OS -# define IF_OS_openbsd(x,y) x -#else -# define IF_OS_openbsd(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - #if linux_TARGET_OS # define IF_OS_linux(x,y) x #else # define IF_OS_linux(x,y) y #endif -- - - - - - - - - - - - - - - - - - - - - - -#if linuxaout_TARGET_OS -# define IF_OS_linuxaout(x,y) x -#else -# define IF_OS_linuxaout(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if bsdi_TARGET_OS -# define IF_OS_bsdi(x,y) x -#else -# define IF_OS_bsdi(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if cygwin32_TARGET_OS -# define IF_OS_cygwin32(x,y) x -#else -# define IF_OS_cygwin32(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if sparc_TARGET_ARCH -# define IF_ARCH_sparc(x,y) x -#else -# define IF_ARCH_sparc(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if sunos4_TARGET_OS -# define IF_OS_sunos4(x,y) x -#else -# define IF_OS_sunos4(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - --- NB: this will catch i386-*-solaris2, too -#if solaris2_TARGET_OS -# define IF_OS_solaris2(x,y) x -#else -# define IF_OS_solaris2(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - -#if powerpc_TARGET_ARCH -# define IF_ARCH_powerpc(x,y) x -#else -# define IF_ARCH_powerpc(x,y) y -#endif --- - - - - - - - - - - - - - - - - - - - - - #if darwin_TARGET_OS # define IF_OS_darwin(x,y) x #else diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index c96badd..736d564 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -910,7 +910,7 @@ genCCall target dest_regs argsAndHints (labelOrExpr, reduceToFF32) <- case target of CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False) CmmCallee expr conv -> return (Right expr, False) - CmmPrim mop -> outOfLineFloatOp mop + CmmPrim mop -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32 @@ -937,7 +937,17 @@ genCCall target dest_regs argsAndHints initialStackOffset = 8 stackDelta finalStack = roundTo 16 finalStack #endif - args = map hintlessCmm argsAndHints + -- need to remove alignment information + argsAndHints' | (CmmPrim mop) <- target, + (mop == MO_Memcpy || + mop == MO_Memset || + mop == MO_Memmove) + = init argsAndHints + + | otherwise + = argsAndHints + + args = map hintlessCmm argsAndHints' argReps = map cmmExprType args roundTo a x | x `mod` a == 0 = x @@ -1062,7 +1072,7 @@ genCCall target dest_regs argsAndHints where rep = cmmRegType (CmmLocal dest) r_dest = getRegisterReg (CmmLocal dest) - outOfLineFloatOp mop = + outOfLineMachOp mop = do dflags <- getDynFlagsNat mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $ @@ -1106,6 +1116,11 @@ genCCall target dest_regs argsAndHints MO_F64_Cosh -> (fsLit "cosh", False) MO_F64_Tanh -> (fsLit "tanh", False) MO_F64_Pwr -> (fsLit "pow", False) + + MO_Memcpy -> (fsLit "memcpy", False) + MO_Memset -> (fsLit "memset", False) + MO_Memmove -> (fsLit "memmove", False) + other -> pprPanic "genCCall(ppc): unknown callish op" (pprCallishMachOp other) diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs index 8d8b16a..bd12a81 100644 --- a/compiler/nativeGen/PPC/Ppr.hs +++ b/compiler/nativeGen/PPC/Ppr.hs @@ -109,9 +109,7 @@ pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> Doc pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext IF_ARCH_sparc((sLit ".global "), - (sLit ".globl ")) <> - pprCLabel_asm lbl + | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl pprTypeAndSizeDecl :: CLabel -> Doc #if linux_TARGET_OS @@ -352,14 +350,9 @@ pprInstr :: Instr -> Doc pprInstr (COMMENT _) = empty -- nuke 'em {- pprInstr (COMMENT s) - = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s)) - ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_powerpc( IF_OS_linux( + IF_OS_linux( ((<>) (ptext (sLit "# ")) (ftext s)), ((<>) (ptext (sLit "; ")) (ftext s))) - ,))))) -} pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs index 91c9e15..bfc712a 100644 --- a/compiler/nativeGen/PPC/RegInfo.hs +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- module PPC.RegInfo ( - JumpDest( DestBlockId ), + JumpDest( DestBlockId ), getJumpDestBlockId, canShortcut, shortcutJump, @@ -31,6 +31,10 @@ import Unique data JumpDest = DestBlockId BlockId | DestImm Imm +getJumpDestBlockId :: JumpDest -> Maybe BlockId +getJumpDestBlockId (DestBlockId bid) = Just bid +getJumpDestBlockId _ = Nothing + canShortcut :: Instr -> Maybe JumpDest canShortcut _ = Nothing diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs index 4c05860..848b266 100644 --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -1,7 +1,7 @@ -{-# OPTIONS -fno-warn-unused-binds #-} +{-# LANGUAGE BangPatterns #-} module RegAlloc.Graph.TrivColorable ( - trivColorable, + trivColorable, ) where @@ -15,78 +15,51 @@ import GraphBase import UniqFM import FastTypes +import Platform +import Panic -- trivColorable --------------------------------------------------------------- -- trivColorable function for the graph coloring allocator -- --- This gets hammered by scanGraph during register allocation, --- so needs to be fairly efficient. +-- This gets hammered by scanGraph during register allocation, +-- so needs to be fairly efficient. -- --- NOTE: This only works for arcitectures with just RcInteger and RcDouble --- (which are disjoint) ie. x86, x86_64 and ppc +-- NOTE: This only works for arcitectures with just RcInteger and RcDouble +-- (which are disjoint) ie. x86, x86_64 and ppc -- --- The number of allocatable regs is hard coded here so we can do a fast --- comparision in trivColorable. +-- The number of allocatable regs is hard coded in here so we can do +-- a fast comparision in trivColorable. -- --- It's ok if these numbers are _less_ than the actual number of free regs, --- but they can't be more or the register conflict graph won't color. +-- It's ok if these numbers are _less_ than the actual number of free +-- regs, but they can't be more or the register conflict +-- graph won't color. -- --- If the graph doesn't color then the allocator will panic, but it won't --- generate bad object code or anything nasty like that. +-- If the graph doesn't color then the allocator will panic, but it won't +-- generate bad object code or anything nasty like that. -- --- There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing --- is too slow for us here. +-- There is an allocatableRegsInClass :: RegClass -> Int, but doing +-- the unboxing is too slow for us here. +-- TODO: Is that still true? Could we use allocatableRegsInClass +-- without losing performance now? -- --- Look at includes/stg/MachRegs.h to get these numbers. +-- Look at includes/stg/MachRegs.h to get the numbers. -- -#if i386_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER (_ILIT(3)) -#define ALLOCATABLE_REGS_DOUBLE (_ILIT(6)) -#define ALLOCATABLE_REGS_FLOAT (_ILIT(0)) -#define ALLOCATABLE_REGS_SSE (_ILIT(8)) - - -#elif x86_64_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER (_ILIT(5)) -#define ALLOCATABLE_REGS_DOUBLE (_ILIT(0)) -#define ALLOCATABLE_REGS_FLOAT (_ILIT(0)) -#define ALLOCATABLE_REGS_SSE (_ILIT(10)) - -#elif powerpc_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER (_ILIT(16)) -#define ALLOCATABLE_REGS_DOUBLE (_ILIT(26)) -#define ALLOCATABLE_REGS_FLOAT (_ILIT(0)) -#define ALLOCATABLE_REGS_SSE (_ILIT(0)) - - -#elif sparc_TARGET_ARCH -#define ALLOCATABLE_REGS_INTEGER (_ILIT(14)) -#define ALLOCATABLE_REGS_DOUBLE (_ILIT(11)) -#define ALLOCATABLE_REGS_FLOAT (_ILIT(22)) -#define ALLOCATABLE_REGS_SSE (_ILIT(0)) - - -#else -#error ToDo: choose which trivColorable function to use for this architecture. -#endif - - -- Disjoint registers ---------------------------------------------------------- --- --- The definition has been unfolded into individual cases for speed. --- Each architecture has a different register setup, so we use a --- different regSqueeze function for each. -- -accSqueeze - :: FastInt - -> FastInt - -> (reg -> FastInt) - -> UniqFM reg - -> FastInt +-- The definition has been unfolded into individual cases for speed. +-- Each architecture has a different register setup, so we use a +-- different regSqueeze function for each. +-- +accSqueeze + :: FastInt + -> FastInt + -> (reg -> FastInt) + -> UniqFM reg + -> FastInt accSqueeze count maxCount squeeze ufm = acc count (eltsUFM ufm) where acc count [] = count @@ -125,60 +98,96 @@ the most efficient variant tried. Benchmark compiling 10-times SHA1.lhs follows. 100.00% 166.23% 94.18% 100.95% -} +-- TODO: We shouldn't be using defaultTargetPlatform here. +-- We should be passing DynFlags in instead, and looking at +-- its targetPlatform. + trivColorable - :: (RegClass -> VirtualReg -> FastInt) - -> (RegClass -> RealReg -> FastInt) - -> Triv VirtualReg RegClass RealReg + :: (RegClass -> VirtualReg -> FastInt) + -> (RegClass -> RealReg -> FastInt) + -> Triv VirtualReg RegClass RealReg trivColorable virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions - | count2 <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_INTEGER - (virtualRegSqueeze RcInteger) - conflicts - - , count3 <- accSqueeze count2 ALLOCATABLE_REGS_INTEGER - (realRegSqueeze RcInteger) - exclusions - - = count3 <# ALLOCATABLE_REGS_INTEGER + | let !cALLOCATABLE_REGS_INTEGER + = iUnbox (case platformArch defaultTargetPlatform of + ArchX86 -> 3 + ArchX86_64 -> 5 + ArchPPC -> 16 + ArchSPARC -> 14 + ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchUnknown -> panic "trivColorable ArchUnknown") + , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_INTEGER + (virtualRegSqueeze RcInteger) + conflicts + + , count3 <- accSqueeze count2 cALLOCATABLE_REGS_INTEGER + (realRegSqueeze RcInteger) + exclusions + + = count3 <# cALLOCATABLE_REGS_INTEGER trivColorable virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions - | count2 <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_FLOAT - (virtualRegSqueeze RcFloat) - conflicts - - , count3 <- accSqueeze count2 ALLOCATABLE_REGS_FLOAT - (realRegSqueeze RcFloat) - exclusions - - = count3 <# ALLOCATABLE_REGS_FLOAT + | let !cALLOCATABLE_REGS_FLOAT + = iUnbox (case platformArch defaultTargetPlatform of + ArchX86 -> 0 + ArchX86_64 -> 0 + ArchPPC -> 0 + ArchSPARC -> 22 + ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchUnknown -> panic "trivColorable ArchUnknown") + , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_FLOAT + (virtualRegSqueeze RcFloat) + conflicts + + , count3 <- accSqueeze count2 cALLOCATABLE_REGS_FLOAT + (realRegSqueeze RcFloat) + exclusions + + = count3 <# cALLOCATABLE_REGS_FLOAT trivColorable virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions - | count2 <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_DOUBLE - (virtualRegSqueeze RcDouble) - conflicts - - , count3 <- accSqueeze count2 ALLOCATABLE_REGS_DOUBLE - (realRegSqueeze RcDouble) - exclusions - - = count3 <# ALLOCATABLE_REGS_DOUBLE + | let !cALLOCATABLE_REGS_DOUBLE + = iUnbox (case platformArch defaultTargetPlatform of + ArchX86 -> 6 + ArchX86_64 -> 0 + ArchPPC -> 26 + ArchSPARC -> 11 + ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchUnknown -> panic "trivColorable ArchUnknown") + , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_DOUBLE + (virtualRegSqueeze RcDouble) + conflicts + + , count3 <- accSqueeze count2 cALLOCATABLE_REGS_DOUBLE + (realRegSqueeze RcDouble) + exclusions + + = count3 <# cALLOCATABLE_REGS_DOUBLE trivColorable virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions - | count2 <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_SSE - (virtualRegSqueeze RcDoubleSSE) - conflicts - - , count3 <- accSqueeze count2 ALLOCATABLE_REGS_SSE - (realRegSqueeze RcDoubleSSE) - exclusions + | let !cALLOCATABLE_REGS_SSE + = iUnbox (case platformArch defaultTargetPlatform of + ArchX86 -> 8 + ArchX86_64 -> 10 + ArchPPC -> 0 + ArchSPARC -> 0 + ArchPPC_64 -> panic "trivColorable ArchPPC_64" + ArchUnknown -> panic "trivColorable ArchUnknown") + , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_SSE + (virtualRegSqueeze RcDoubleSSE) + conflicts - = count3 <# ALLOCATABLE_REGS_SSE + , count3 <- accSqueeze count2 cALLOCATABLE_REGS_SSE + (realRegSqueeze RcDoubleSSE) + exclusions + + = count3 <# cALLOCATABLE_REGS_SSE -- Specification Code ---------------------------------------------------------- -- --- The trivColorable function for each particular architecture should --- implement the following function, but faster. +-- The trivColorable function for each particular architecture should +-- implement the following function, but faster. -- {- @@ -186,39 +195,39 @@ trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool trivColorable classN conflicts exclusions = let - acc :: Reg -> (Int, Int) -> (Int, Int) - acc r (cd, cf) - = case regClass r of - RcInteger -> (cd+1, cf) - RcFloat -> (cd, cf+1) - _ -> panic "Regs.trivColorable: reg class not handled" + acc :: Reg -> (Int, Int) -> (Int, Int) + acc r (cd, cf) + = case regClass r of + RcInteger -> (cd+1, cf) + RcFloat -> (cd, cf+1) + _ -> panic "Regs.trivColorable: reg class not handled" - tmp = foldUniqSet acc (0, 0) conflicts - (countInt, countFloat) = foldUniqSet acc tmp exclusions + tmp = foldUniqSet acc (0, 0) conflicts + (countInt, countFloat) = foldUniqSet acc tmp exclusions - squeese = worst countInt classN RcInteger - + worst countFloat classN RcFloat + squeese = worst countInt classN RcInteger + + worst countFloat classN RcFloat - in squeese < allocatableRegsInClass classN + in squeese < allocatableRegsInClass classN -- | Worst case displacement --- node N of classN has n neighbors of class C. +-- node N of classN has n neighbors of class C. -- --- We currently only have RcInteger and RcDouble, which don't conflict at all. --- This is a bit boring compared to what's in RegArchX86. +-- We currently only have RcInteger and RcDouble, which don't conflict at all. +-- This is a bit boring compared to what's in RegArchX86. -- worst :: Int -> RegClass -> RegClass -> Int worst n classN classC = case classN of - RcInteger - -> case classC of - RcInteger -> min n (allocatableRegsInClass RcInteger) - RcFloat -> 0 - - RcDouble - -> case classC of - RcFloat -> min n (allocatableRegsInClass RcFloat) - RcInteger -> 0 + RcInteger + -> case classC of + RcInteger -> min n (allocatableRegsInClass RcInteger) + RcFloat -> 0 + + RcDouble + -> case classC of + RcFloat -> min n (allocatableRegsInClass RcFloat) + RcInteger -> 0 -- allocatableRegs is allMachRegNos with the fixed-use regs removed. -- i.e., these are the regs for which we are prepared to allow the @@ -230,21 +239,21 @@ allocatableRegs -- | The number of regs in each class. --- We go via top level CAFs to ensure that we're not recomputing --- the length of these lists each time the fn is called. +-- We go via top level CAFs to ensure that we're not recomputing +-- the length of these lists each time the fn is called. allocatableRegsInClass :: RegClass -> Int allocatableRegsInClass cls = case cls of - RcInteger -> allocatableRegsInteger - RcFloat -> allocatableRegsDouble + RcInteger -> allocatableRegsInteger + RcFloat -> allocatableRegsDouble allocatableRegsInteger :: Int -allocatableRegsInteger - = length $ filter (\r -> regClass r == RcInteger) - $ map RealReg allocatableRegs +allocatableRegsInteger + = length $ filter (\r -> regClass r == RcInteger) + $ map RealReg allocatableRegs allocatableRegsFloat :: Int allocatableRegsFloat - = length $ filter (\r -> regClass r == RcFloat - $ map RealReg allocatableRegs + = length $ filter (\r -> regClass r == RcFloat + $ map RealReg allocatableRegs -} diff --git a/compiler/nativeGen/RegAlloc/Linear/Base.hs b/compiler/nativeGen/RegAlloc/Linear/Base.hs index 9fd090c..432acdf 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Base.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Base.hs @@ -2,23 +2,22 @@ -- | Put common type definitions here to break recursive module dependencies. module RegAlloc.Linear.Base ( - BlockAssignment, - - Loc(..), - regsOfLoc, - - -- for stats - SpillReason(..), - RegAllocStats(..), - - -- the allocator monad - RA_State(..), - RegM(..) + BlockAssignment, + + Loc(..), + regsOfLoc, + + -- for stats + SpillReason(..), + RegAllocStats(..), + + -- the allocator monad + RA_State(..), + RegM(..) ) where -import RegAlloc.Linear.FreeRegs import RegAlloc.Linear.StackMap import RegAlloc.Liveness import Reg @@ -30,40 +29,40 @@ import UniqSupply -- | Used to store the register assignment on entry to a basic block. --- We use this to handle join points, where multiple branch instructions --- target a particular label. We have to insert fixup code to make --- the register assignments from the different sources match up. +-- We use this to handle join points, where multiple branch instructions +-- target a particular label. We have to insert fixup code to make +-- the register assignments from the different sources match up. -- -type BlockAssignment - = BlockMap (FreeRegs, RegMap Loc) +type BlockAssignment freeRegs + = BlockMap (freeRegs, RegMap Loc) -- | Where a vreg is currently stored --- A temporary can be marked as living in both a register and memory --- (InBoth), for example if it was recently loaded from a spill location. --- This makes it cheap to spill (no save instruction required), but we --- have to be careful to turn this into InReg if the value in the --- register is changed. - --- This is also useful when a temporary is about to be clobbered. We --- save it in a spill location, but mark it as InBoth because the current --- instruction might still want to read it. +-- A temporary can be marked as living in both a register and memory +-- (InBoth), for example if it was recently loaded from a spill location. +-- This makes it cheap to spill (no save instruction required), but we +-- have to be careful to turn this into InReg if the value in the +-- register is changed. + +-- This is also useful when a temporary is about to be clobbered. We +-- save it in a spill location, but mark it as InBoth because the current +-- instruction might still want to read it. -- -data Loc - -- | vreg is in a register - = InReg !RealReg +data Loc + -- | vreg is in a register + = InReg !RealReg - -- | vreg is held in a stack slot - | InMem {-# UNPACK #-} !StackSlot + -- | vreg is held in a stack slot + | InMem {-# UNPACK #-} !StackSlot - -- | vreg is held in both a register and a stack slot - | InBoth !RealReg - {-# UNPACK #-} !StackSlot - deriving (Eq, Show, Ord) + -- | vreg is held in both a register and a stack slot + | InBoth !RealReg + {-# UNPACK #-} !StackSlot + deriving (Eq, Show, Ord) instance Outputable Loc where - ppr l = text (show l) + ppr l = text (show l) -- | Get the reg numbers stored in this Loc. @@ -74,64 +73,64 @@ regsOfLoc (InMem _) = [] -- | Reasons why instructions might be inserted by the spiller. --- Used when generating stats for -ddrop-asm-stats. +-- Used when generating stats for -ddrop-asm-stats. -- data SpillReason - -- | vreg was spilled to a slot so we could use its - -- current hreg for another vreg - = SpillAlloc !Unique + -- | vreg was spilled to a slot so we could use its + -- current hreg for another vreg + = SpillAlloc !Unique - -- | vreg was moved because its hreg was clobbered - | SpillClobber !Unique + -- | vreg was moved because its hreg was clobbered + | SpillClobber !Unique - -- | vreg was loaded from a spill slot - | SpillLoad !Unique + -- | vreg was loaded from a spill slot + | SpillLoad !Unique - -- | reg-reg move inserted during join to targets - | SpillJoinRR !Unique + -- | reg-reg move inserted during join to targets + | SpillJoinRR !Unique - -- | reg-mem move inserted during join to targets - | SpillJoinRM !Unique + -- | reg-mem move inserted during join to targets + | SpillJoinRM !Unique -- | Used to carry interesting stats out of the register allocator. data RegAllocStats - = RegAllocStats - { ra_spillInstrs :: UniqFM [Int] } + = RegAllocStats + { ra_spillInstrs :: UniqFM [Int] } -- | The register alloctor state -data RA_State - = RA_State +data RA_State freeRegs + = RA_State + + { + -- | the current mapping from basic blocks to + -- the register assignments at the beginning of that block. + ra_blockassig :: BlockAssignment freeRegs - { - -- | the current mapping from basic blocks to - -- the register assignments at the beginning of that block. - ra_blockassig :: BlockAssignment - - -- | free machine registers - , ra_freeregs :: {-#UNPACK#-}!FreeRegs + -- | free machine registers + , ra_freeregs :: !freeRegs - -- | assignment of temps to locations - , ra_assig :: RegMap Loc + -- | assignment of temps to locations + , ra_assig :: RegMap Loc - -- | current stack delta - , ra_delta :: Int + -- | current stack delta + , ra_delta :: Int - -- | free stack slots for spilling - , ra_stack :: StackMap + -- | free stack slots for spilling + , ra_stack :: StackMap - -- | unique supply for generating names for join point fixup blocks. - , ra_us :: UniqSupply + -- | unique supply for generating names for join point fixup blocks. + , ra_us :: UniqSupply - -- | Record why things were spilled, for -ddrop-asm-stats. - -- Just keep a list here instead of a map of regs -> reasons. - -- We don't want to slow down the allocator if we're not going to emit the stats. - , ra_spills :: [SpillReason] } + -- | Record why things were spilled, for -ddrop-asm-stats. + -- Just keep a list here instead of a map of regs -> reasons. + -- We don't want to slow down the allocator if we're not going to emit the stats. + , ra_spills :: [SpillReason] } -- | The register allocator monad type. -newtype RegM a - = RegM { unReg :: RA_State -> (# RA_State, a #) } +newtype RegM freeRegs a + = RegM { unReg :: RA_State freeRegs -> (# RA_State freeRegs, a #) } diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs index b357160..b442d06 100644 --- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs @@ -1,18 +1,19 @@ module RegAlloc.Linear.FreeRegs ( - FreeRegs(), - noFreeRegs, - releaseReg, - initFreeRegs, - getFreeRegs, - allocateReg, - maxSpillSlots + FR(..), + maxSpillSlots ) #include "HsVersions.h" where +import Reg +import RegClass + +import Panic +import Platform + -- ----------------------------------------------------------------------------- -- The free register set -- This needs to be *efficient* @@ -25,21 +26,48 @@ where -- getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f -- allocateReg f r = filter (/= r) f +import qualified RegAlloc.Linear.PPC.FreeRegs as PPC +import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC +import qualified RegAlloc.Linear.X86.FreeRegs as X86 + +import qualified PPC.Instr +import qualified SPARC.Instr +import qualified X86.Instr + +class Show freeRegs => FR freeRegs where + frAllocateReg :: RealReg -> freeRegs -> freeRegs + frGetFreeRegs :: RegClass -> freeRegs -> [RealReg] + frInitFreeRegs :: freeRegs + frReleaseReg :: RealReg -> freeRegs -> freeRegs -#if defined(powerpc_TARGET_ARCH) -import RegAlloc.Linear.PPC.FreeRegs -import PPC.Instr (maxSpillSlots) +instance FR X86.FreeRegs where + frAllocateReg = X86.allocateReg + frGetFreeRegs = X86.getFreeRegs + frInitFreeRegs = X86.initFreeRegs + frReleaseReg = X86.releaseReg -#elif defined(sparc_TARGET_ARCH) -import RegAlloc.Linear.SPARC.FreeRegs -import SPARC.Instr (maxSpillSlots) +instance FR PPC.FreeRegs where + frAllocateReg = PPC.allocateReg + frGetFreeRegs = PPC.getFreeRegs + frInitFreeRegs = PPC.initFreeRegs + frReleaseReg = PPC.releaseReg -#elif defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH) -import RegAlloc.Linear.X86.FreeRegs -import X86.Instr (maxSpillSlots) +instance FR SPARC.FreeRegs where + frAllocateReg = SPARC.allocateReg + frGetFreeRegs = SPARC.getFreeRegs + frInitFreeRegs = SPARC.initFreeRegs + frReleaseReg = SPARC.releaseReg -#else -#error "RegAlloc.Linear.FreeRegs not defined for this architecture." +-- TODO: We shouldn't be using defaultTargetPlatform here. +-- We should be passing DynFlags in instead, and looking at +-- its targetPlatform. -#endif +maxSpillSlots :: Int +maxSpillSlots = case platformArch defaultTargetPlatform of + ArchX86 -> X86.Instr.maxSpillSlots + ArchX86_64 -> X86.Instr.maxSpillSlots + ArchPPC -> PPC.Instr.maxSpillSlots + ArchSPARC -> SPARC.Instr.maxSpillSlots + ArchPPC_64 -> panic "maxSpillSlots ArchPPC_64" + ArchUnknown -> panic "maxSpillSlots ArchUnknown" diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs index ef6ae9b..e6a078a 100644 --- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs +++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -fno-warn-missing-signatures #-} - -- | Handles joining of a jump instruction to its targets. @@ -35,14 +33,14 @@ import UniqSet -- vregs are in the correct regs for its destination. -- joinToTargets - :: Instruction instr + :: (FR freeRegs, Instruction instr) => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. -> BlockId -- ^ id of the current block -> instr -- ^ branch instr on the end of the source block. - -> RegM ([NatBasicBlock instr] -- fresh blocks of fixup code. + -> RegM freeRegs ([NatBasicBlock instr] -- fresh blocks of fixup code. , instr) -- the original branch instruction, but maybe patched to jump -- to a fixup block first. @@ -57,7 +55,7 @@ joinToTargets block_live id instr ----- joinToTargets' - :: Instruction instr + :: (FR freeRegs, Instruction instr) => BlockMap RegSet -- ^ maps the unique of the blockid to the set of vregs -- that are known to be live on the entry to each block. @@ -68,7 +66,7 @@ joinToTargets' -> [BlockId] -- ^ branch destinations still to consider. - -> RegM ( [NatBasicBlock instr] + -> RegM freeRegs ( [NatBasicBlock instr] , instr) -- no more targets to consider. all done. @@ -109,13 +107,24 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests) -- this is the first time we jumped to this block. +joinToTargets_first :: (FR freeRegs, Instruction instr) + => BlockMap RegSet + -> [NatBasicBlock instr] + -> BlockId + -> instr + -> BlockId + -> [BlockId] + -> BlockAssignment freeRegs + -> RegMap Loc + -> [RealReg] + -> RegM freeRegs ([NatBasicBlock instr], instr) joinToTargets_first block_live new_blocks block_id instr dest dests block_assig src_assig - (to_free :: [RealReg]) + to_free = do -- free up the regs that are not live on entry to this block. freeregs <- getFreeRegsR - let freeregs' = foldr releaseReg freeregs to_free + let freeregs' = foldr frReleaseReg freeregs to_free -- remember the current assignment on entry to this block. setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig) @@ -124,6 +133,16 @@ joinToTargets_first block_live new_blocks block_id instr dest dests -- we've jumped to this block before +joinToTargets_again :: (Instruction instr, FR freeRegs) + => BlockMap RegSet + -> [NatBasicBlock instr] + -> BlockId + -> instr + -> BlockId + -> [BlockId] + -> UniqFM Loc + -> UniqFM Loc + -> RegM freeRegs ([NatBasicBlock instr], instr) joinToTargets_again block_live new_blocks block_id instr dest dests src_assig dest_assig @@ -262,7 +281,7 @@ expandNode vreg src dst -- handleComponent :: Instruction instr - => Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM [instr] + => Int -> instr -> SCC (Unique, Loc, [Loc]) -> RegM freeRegs [instr] -- If the graph is acyclic then we won't get the swapping problem below. -- In this case we can just do the moves directly, and avoid having to @@ -317,7 +336,7 @@ makeMove -> Unique -- ^ unique of the vreg that we're moving. -> Loc -- ^ source location. -> Loc -- ^ destination location. - -> RegM instr -- ^ move instruction. + -> RegM freeRegs instr -- ^ move instruction. makeMove _ vreg (InReg src) (InReg dst) = do recordSpill (SpillJoinRR vreg) diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 473b549..b91c2d0 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -1,4 +1,3 @@ -{-# OPTIONS -fno-warn-missing-signatures #-} ----------------------------------------------------------------------------- -- -- The register allocator @@ -9,82 +8,82 @@ {- The algorithm is roughly: - + 1) Compute strongly connected components of the basic block list. 2) Compute liveness (mapping from pseudo register to point(s) of death?). 3) Walk instructions in each basic block. We keep track of - (a) Free real registers (a bitmap?) - (b) Current assignment of temporaries to machine registers and/or - spill slots (call this the "assignment"). - (c) Partial mapping from basic block ids to a virt-to-loc mapping. - When we first encounter a branch to a basic block, - we fill in its entry in this table with the current mapping. + (a) Free real registers (a bitmap?) + (b) Current assignment of temporaries to machine registers and/or + spill slots (call this the "assignment"). + (c) Partial mapping from basic block ids to a virt-to-loc mapping. + When we first encounter a branch to a basic block, + we fill in its entry in this table with the current mapping. For each instruction: - (a) For each real register clobbered by this instruction: - If a temporary resides in it, - If the temporary is live after this instruction, - Move the temporary to another (non-clobbered & free) reg, - or spill it to memory. Mark the temporary as residing - in both memory and a register if it was spilled (it might - need to be read by this instruction). - (ToDo: this is wrong for jump instructions?) - - (b) For each temporary *read* by the instruction: - If the temporary does not have a real register allocation: - - Allocate a real register from the free list. If - the list is empty: - - Find a temporary to spill. Pick one that is - not used in this instruction (ToDo: not - used for a while...) - - generate a spill instruction - - If the temporary was previously spilled, - generate an instruction to read the temp from its spill loc. - (optimisation: if we can see that a real register is going to + (a) For each real register clobbered by this instruction: + If a temporary resides in it, + If the temporary is live after this instruction, + Move the temporary to another (non-clobbered & free) reg, + or spill it to memory. Mark the temporary as residing + in both memory and a register if it was spilled (it might + need to be read by this instruction). + (ToDo: this is wrong for jump instructions?) + + (b) For each temporary *read* by the instruction: + If the temporary does not have a real register allocation: + - Allocate a real register from the free list. If + the list is empty: + - Find a temporary to spill. Pick one that is + not used in this instruction (ToDo: not + used for a while...) + - generate a spill instruction + - If the temporary was previously spilled, + generate an instruction to read the temp from its spill loc. + (optimisation: if we can see that a real register is going to be used soon, then don't use it for allocation). - (c) Update the current assignment + (c) Update the current assignment - (d) If the instruction is a branch: - if the destination block already has a register assignment, - Generate a new block with fixup code and redirect the - jump to the new block. - else, - Update the block id->assignment mapping with the current - assignment. + (d) If the instruction is a branch: + if the destination block already has a register assignment, + Generate a new block with fixup code and redirect the + jump to the new block. + else, + Update the block id->assignment mapping with the current + assignment. - (e) Delete all register assignments for temps which are read - (only) and die here. Update the free register list. + (e) Delete all register assignments for temps which are read + (only) and die here. Update the free register list. - (f) Mark all registers clobbered by this instruction as not free, - and mark temporaries which have been spilled due to clobbering - as in memory (step (a) marks then as in both mem & reg). + (f) Mark all registers clobbered by this instruction as not free, + and mark temporaries which have been spilled due to clobbering + as in memory (step (a) marks then as in both mem & reg). - (g) For each temporary *written* by this instruction: - Allocate a real register as for (b), spilling something - else if necessary. - - except when updating the assignment, drop any memory - locations that the temporary was previously in, since - they will be no longer valid after this instruction. + (g) For each temporary *written* by this instruction: + Allocate a real register as for (b), spilling something + else if necessary. + - except when updating the assignment, drop any memory + locations that the temporary was previously in, since + they will be no longer valid after this instruction. - (h) Delete all register assignments for temps which are - written and die here (there should rarely be any). Update - the free register list. + (h) Delete all register assignments for temps which are + written and die here (there should rarely be any). Update + the free register list. - (i) Rewrite the instruction with the new mapping. + (i) Rewrite the instruction with the new mapping. - (j) For each spilled reg known to be now dead, re-add its stack slot - to the free list. + (j) For each spilled reg known to be now dead, re-add its stack slot + to the free list. -} module RegAlloc.Linear.Main ( - regAlloc, - module RegAlloc.Linear.Base, - module RegAlloc.Linear.Stats + regAlloc, + module RegAlloc.Linear.Base, + module RegAlloc.Linear.Stats ) where #include "HsVersions.h" @@ -96,6 +95,9 @@ import RegAlloc.Linear.StackMap import RegAlloc.Linear.FreeRegs import RegAlloc.Linear.Stats import RegAlloc.Linear.JoinToTargets +import qualified RegAlloc.Linear.PPC.FreeRegs as PPC +import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC +import qualified RegAlloc.Linear.X86.FreeRegs as X86 import TargetReg import RegAlloc.Liveness import Instruction @@ -105,11 +107,13 @@ import BlockId import OldCmm hiding (RegSet) import Digraph +import DynFlags import Unique import UniqSet import UniqFM import UniqSupply import Outputable +import Platform import Data.Maybe import Data.List @@ -122,38 +126,39 @@ import Control.Monad -- Top level of the register allocator -- Allocate registers -regAlloc - :: (Outputable instr, Instruction instr) - => LiveCmmTop instr - -> UniqSM (NatCmmTop instr, Maybe RegAllocStats) - -regAlloc (CmmData sec d) - = return - ( CmmData sec d - , Nothing ) - -regAlloc (CmmProc (LiveInfo info _ _ _) lbl []) - = return ( CmmProc info lbl (ListGraph []) - , Nothing ) - -regAlloc (CmmProc static lbl sccs) - | LiveInfo info (Just first_id) (Just block_live) _ <- static - = do - -- do register allocation on each component. - (final_blocks, stats) - <- linearRegAlloc first_id block_live sccs - - -- make sure the block that was first in the input list - -- stays at the front of the output - let ((first':_), rest') - = partition ((== first_id) . blockId) final_blocks - - return ( CmmProc info lbl (ListGraph (first' : rest')) - , Just stats) - +regAlloc + :: (Outputable instr, Instruction instr) + => DynFlags + -> LiveCmmTop instr + -> UniqSM (NatCmmTop instr, Maybe RegAllocStats) + +regAlloc _ (CmmData sec d) + = return + ( CmmData sec d + , Nothing ) + +regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl []) + = return ( CmmProc info lbl (ListGraph []) + , Nothing ) + +regAlloc dflags (CmmProc static lbl sccs) + | LiveInfo info (Just first_id) (Just block_live) _ <- static + = do + -- do register allocation on each component. + (final_blocks, stats) + <- linearRegAlloc dflags first_id block_live sccs + + -- make sure the block that was first in the input list + -- stays at the front of the output + let ((first':_), rest') + = partition ((== first_id) . blockId) final_blocks + + return ( CmmProc info lbl (ListGraph (first' : rest')) + , Just stats) + -- bogus. to make non-exhaustive match warning go away. -regAlloc (CmmProc _ _ _) - = panic "RegAllocLinear.regAlloc: no match" +regAlloc _ (CmmProc _ _ _) + = panic "RegAllocLinear.regAlloc: no match" -- ----------------------------------------------------------------------------- @@ -165,161 +170,196 @@ regAlloc (CmmProc _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: (Outputable instr, Instruction instr) - => BlockId -- ^ the first block - -> BlockMap RegSet -- ^ live regs on entry to each basic block - -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" - -> UniqSM ([NatBasicBlock instr], RegAllocStats) - -linearRegAlloc first_id block_live sccs - = do us <- getUs - let (_, _, stats, blocks) = - runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us - $ linearRA_SCCs first_id block_live [] sccs - - return (blocks, stats) + :: (Outputable instr, Instruction instr) + => DynFlags + -> BlockId -- ^ the first block + -> BlockMap RegSet -- ^ live regs on entry to each basic block + -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" + -> UniqSM ([NatBasicBlock instr], RegAllocStats) + +linearRegAlloc dflags first_id block_live sccs + = case platformArch $ targetPlatform dflags of + ArchX86 -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs) first_id block_live sccs + ArchX86_64 -> linearRegAlloc' (frInitFreeRegs :: X86.FreeRegs) first_id block_live sccs + ArchSPARC -> linearRegAlloc' (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs + ArchPPC -> linearRegAlloc' (frInitFreeRegs :: PPC.FreeRegs) first_id block_live sccs + ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64" + ArchUnknown -> panic "linearRegAlloc ArchUnknown" + +linearRegAlloc' + :: (FR freeRegs, Outputable instr, Instruction instr) + => freeRegs + -> BlockId -- ^ the first block + -> BlockMap RegSet -- ^ live regs on entry to each basic block + -> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths" + -> UniqSM ([NatBasicBlock instr], RegAllocStats) + +linearRegAlloc' initFreeRegs first_id block_live sccs + = do us <- getUs + let (_, _, stats, blocks) = + runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us + $ linearRA_SCCs first_id block_live [] sccs + return (blocks, stats) + + +linearRA_SCCs :: (FR freeRegs, Instruction instr, Outputable instr) + => BlockId + -> BlockMap RegSet + -> [NatBasicBlock instr] + -> [SCC (LiveBasicBlock instr)] + -> RegM freeRegs [NatBasicBlock instr] linearRA_SCCs _ _ blocksAcc [] - = return $ reverse blocksAcc + = return $ reverse blocksAcc -linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs) - = do blocks' <- processBlock block_live block - linearRA_SCCs first_id block_live - ((reverse blocks') ++ blocksAcc) - sccs +linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs) + = do blocks' <- processBlock block_live block + linearRA_SCCs first_id block_live + ((reverse blocks') ++ blocksAcc) + sccs -linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs) +linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs) = do blockss' <- process first_id block_live blocks [] (return []) False - linearRA_SCCs first_id block_live - (reverse (concat blockss') ++ blocksAcc) - sccs + linearRA_SCCs first_id block_live + (reverse (concat blockss') ++ blocksAcc) + sccs {- from John Dias's patch 2008/10/16: The linear-scan allocator sometimes allocates a block - before allocating one of its predecessors, which could lead to + before allocating one of its predecessors, which could lead to inconsistent allocations. Make it so a block is only allocated if a predecessor has set the "incoming" assignments for the block, or if it's the procedure's entry block. BL 2009/02: Careful. If the assignment for a block doesn't get set for - some reason then this function will loop. We should probably do some + some reason then this function will loop. We should probably do some more sanity checking to guard against this eventuality. -} +process :: (FR freeRegs, Instruction instr, Outputable instr) + => BlockId + -> BlockMap RegSet + -> [GenBasicBlock (LiveInstr instr)] + -> [GenBasicBlock (LiveInstr instr)] + -> [[NatBasicBlock instr]] + -> Bool + -> RegM freeRegs [[NatBasicBlock instr]] + process _ _ [] [] accum _ - = return $ reverse accum + = return $ reverse accum process first_id block_live [] next_round accum madeProgress - | not madeProgress - - {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming. - pprTrace "RegAlloc.Linear.Main.process: no progress made, bailing out." - ( text "Unreachable blocks:" - $$ vcat (map ppr next_round)) -} - = return $ reverse accum - - | otherwise - = process first_id block_live - next_round [] accum False - -process first_id block_live (b@(BasicBlock id _) : blocks) - next_round accum madeProgress - = do - block_assig <- getBlockAssigR - - if isJust (mapLookup id block_assig) + | not madeProgress + + {- BUGS: There are so many unreachable blocks in the code the warnings are overwhelming. + pprTrace "RegAlloc.Linear.Main.process: no progress made, bailing out." + ( text "Unreachable blocks:" + $$ vcat (map ppr next_round)) -} + = return $ reverse accum + + | otherwise + = process first_id block_live + next_round [] accum False + +process first_id block_live (b@(BasicBlock id _) : blocks) + next_round accum madeProgress + = do + block_assig <- getBlockAssigR + + if isJust (mapLookup id block_assig) || id == first_id - then do - b' <- processBlock block_live b - process first_id block_live blocks - next_round (b' : accum) True + then do + b' <- processBlock block_live b + process first_id block_live blocks + next_round (b' : accum) True - else process first_id block_live blocks - (b : next_round) accum madeProgress + else process first_id block_live blocks + (b : next_round) accum madeProgress -- | Do register allocation on this basic block -- processBlock - :: (Outputable instr, Instruction instr) - => BlockMap RegSet -- ^ live regs on entry to each basic block - -> LiveBasicBlock instr -- ^ block to do register allocation on - -> RegM [NatBasicBlock instr] -- ^ block with registers allocated + :: (FR freeRegs, Outputable instr, Instruction instr) + => BlockMap RegSet -- ^ live regs on entry to each basic block + -> LiveBasicBlock instr -- ^ block to do register allocation on + -> RegM freeRegs [NatBasicBlock instr] -- ^ block with registers allocated processBlock block_live (BasicBlock id instrs) - = do initBlock id - (instrs', fixups) - <- linearRA block_live [] [] id instrs - return $ BasicBlock id instrs' : fixups + = do initBlock id + (instrs', fixups) + <- linearRA block_live [] [] id instrs + return $ BasicBlock id instrs' : fixups -- | Load the freeregs and current reg assignment into the RegM state --- for the basic block with this BlockId. -initBlock :: BlockId -> RegM () +-- for the basic block with this BlockId. +initBlock :: FR freeRegs => BlockId -> RegM freeRegs () initBlock id - = do block_assig <- getBlockAssigR - case mapLookup id block_assig of - -- no prior info about this block: assume everything is - -- free and the assignment is empty. - Nothing - -> do -- pprTrace "initFreeRegs" (text $ show initFreeRegs) (return ()) - - setFreeRegsR initFreeRegs - setAssigR emptyRegMap - - -- load info about register assignments leading into this block. - Just (freeregs, assig) - -> do setFreeRegsR freeregs - setAssigR assig + = do block_assig <- getBlockAssigR + case mapLookup id block_assig of + -- no prior info about this block: assume everything is + -- free and the assignment is empty. + Nothing + -> do -- pprTrace "initFreeRegs" (text $ show initFreeRegs) (return ()) + + setFreeRegsR frInitFreeRegs + setAssigR emptyRegMap + + -- load info about register assignments leading into this block. + Just (freeregs, assig) + -> do setFreeRegsR freeregs + setAssigR assig -- | Do allocation for a sequence of instructions. linearRA - :: (Outputable instr, Instruction instr) - => BlockMap RegSet -- ^ map of what vregs are live on entry to each block. - -> [instr] -- ^ accumulator for instructions already processed. - -> [NatBasicBlock instr] -- ^ accumulator for blocks of fixup code. - -> BlockId -- ^ id of the current block, for debugging. - -> [LiveInstr instr] -- ^ liveness annotated instructions in this block. + :: (FR freeRegs, Outputable instr, Instruction instr) + => BlockMap RegSet -- ^ map of what vregs are live on entry to each block. + -> [instr] -- ^ accumulator for instructions already processed. + -> [NatBasicBlock instr] -- ^ accumulator for blocks of fixup code. + -> BlockId -- ^ id of the current block, for debugging. + -> [LiveInstr instr] -- ^ liveness annotated instructions in this block. - -> RegM ( [instr] -- instructions after register allocation - , [NatBasicBlock instr]) -- fresh blocks of fixup code. + -> RegM freeRegs + ( [instr] -- instructions after register allocation + , [NatBasicBlock instr]) -- fresh blocks of fixup code. linearRA _ accInstr accFixup _ [] - = return - ( reverse accInstr -- instrs need to be returned in the correct order. - , accFixup) -- it doesn't matter what order the fixup blocks are returned in. + = return + ( reverse accInstr -- instrs need to be returned in the correct order. + , accFixup) -- it doesn't matter what order the fixup blocks are returned in. linearRA block_live accInstr accFixups id (instr:instrs) = do - (accInstr', new_fixups) - <- raInsn block_live accInstr id instr + (accInstr', new_fixups) + <- raInsn block_live accInstr id instr - linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs + linearRA block_live accInstr' (new_fixups ++ accFixups) id instrs -- | Do allocation for a single instruction. -raInsn - :: (Outputable instr, Instruction instr) - => BlockMap RegSet -- ^ map of what vregs are love on entry to each block. - -> [instr] -- ^ accumulator for instructions already processed. - -> BlockId -- ^ the id of the current block, for debugging - -> LiveInstr instr -- ^ the instr to have its regs allocated, with liveness info. - -> RegM - ( [instr] -- new instructions - , [NatBasicBlock instr]) -- extra fixup blocks - -raInsn _ new_instrs _ (LiveInstr ii Nothing) - | Just n <- takeDeltaInstr ii - = do setDeltaR n - return (new_instrs, []) +raInsn + :: (FR freeRegs, Outputable instr, Instruction instr) + => BlockMap RegSet -- ^ map of what vregs are love on entry to each block. + -> [instr] -- ^ accumulator for instructions already processed. + -> BlockId -- ^ the id of the current block, for debugging + -> LiveInstr instr -- ^ the instr to have its regs allocated, with liveness info. + -> RegM freeRegs + ( [instr] -- new instructions + , [NatBasicBlock instr]) -- extra fixup blocks raInsn _ new_instrs _ (LiveInstr ii Nothing) - | isMetaInstr ii - = return (new_instrs, []) + | Just n <- takeDeltaInstr ii + = do setDeltaR n + return (new_instrs, []) + +raInsn _ new_instrs _ (LiveInstr ii Nothing) + | isMetaInstr ii + = return (new_instrs, []) raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live)) @@ -334,78 +374,85 @@ raInsn block_live new_instrs id (LiveInstr (Instr instr) (Just live)) -- (we can't eliminate it if the source register is on the stack, because -- we do not want to use one spill slot for different virtual registers) case takeRegRegMoveInstr instr of - Just (src,dst) | src `elementOfUniqSet` (liveDieRead live), - isVirtualReg dst, - not (dst `elemUFM` assig), - Just (InReg _) <- (lookupUFM assig src) -> do - case src of - (RegReal rr) -> setAssigR (addToUFM assig dst (InReg rr)) - -- if src is a fixed reg, then we just map dest to this - -- reg in the assignment. src must be an allocatable reg, - -- otherwise it wouldn't be in r_dying. - _virt -> case lookupUFM assig src of - Nothing -> panic "raInsn" - Just loc -> - setAssigR (addToUFM (delFromUFM assig src) dst loc) - - -- we have eliminated this instruction + Just (src,dst) | src `elementOfUniqSet` (liveDieRead live), + isVirtualReg dst, + not (dst `elemUFM` assig), + Just (InReg _) <- (lookupUFM assig src) -> do + case src of + (RegReal rr) -> setAssigR (addToUFM assig dst (InReg rr)) + -- if src is a fixed reg, then we just map dest to this + -- reg in the assignment. src must be an allocatable reg, + -- otherwise it wouldn't be in r_dying. + _virt -> case lookupUFM assig src of + Nothing -> panic "raInsn" + Just loc -> + setAssigR (addToUFM (delFromUFM assig src) dst loc) + + -- we have eliminated this instruction {- - freeregs <- getFreeRegsR - assig <- getAssigR - pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr) - $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do + freeregs <- getFreeRegsR + assig <- getAssigR + pprTrace "raInsn" (text "ELIMINATED: " <> docToSDoc (pprInstr instr) + $$ ppr r_dying <+> ppr w_dying $$ text (show freeregs) $$ ppr assig) $ do -} - return (new_instrs, []) + return (new_instrs, []) - _ -> genRaInsn block_live new_instrs id instr - (uniqSetToList $ liveDieRead live) - (uniqSetToList $ liveDieWrite live) + _ -> genRaInsn block_live new_instrs id instr + (uniqSetToList $ liveDieRead live) + (uniqSetToList $ liveDieWrite live) raInsn _ _ _ instr - = pprPanic "raInsn" (text "no match for:" <> ppr instr) - + = pprPanic "raInsn" (text "no match for:" <> ppr instr) +genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr) + => BlockMap RegSet + -> [instr] + -> BlockId + -> instr + -> [Reg] + -> [Reg] + -> RegM freeRegs ([instr], [NatBasicBlock instr]) genRaInsn block_live new_instrs block_id instr r_dying w_dying = case regUsageOfInstr instr of { RU read written -> do - let real_written = [ rr | (RegReal rr) <- written ] - let virt_written = [ vr | (RegVirtual vr) <- written ] + let real_written = [ rr | (RegReal rr) <- written ] + let virt_written = [ vr | (RegVirtual vr) <- written ] -- we don't need to do anything with real registers that are -- only read by this instr. (the list is typically ~2 elements, -- so using nub isn't a problem). - let virt_read = nub [ vr | (RegVirtual vr) <- read ] + let virt_read = nub [ vr | (RegVirtual vr) <- read ] -- (a) save any temporaries which will be clobbered by this instruction - clobber_saves <- saveClobberedTemps real_written r_dying + clobber_saves <- saveClobberedTemps real_written r_dying -- debugging {- freeregs <- getFreeRegsR assig <- getAssigR - pprTrace "genRaInsn" - (ppr instr - $$ text "r_dying = " <+> ppr r_dying - $$ text "w_dying = " <+> ppr w_dying - $$ text "virt_read = " <+> ppr virt_read - $$ text "virt_written = " <+> ppr virt_written - $$ text "freeregs = " <+> text (show freeregs) - $$ text "assig = " <+> ppr assig) - $ do + pprTrace "genRaInsn" + (ppr instr + $$ text "r_dying = " <+> ppr r_dying + $$ text "w_dying = " <+> ppr w_dying + $$ text "virt_read = " <+> ppr virt_read + $$ text "virt_written = " <+> ppr virt_written + $$ text "freeregs = " <+> text (show freeregs) + $$ text "assig = " <+> ppr assig) + $ do -} -- (b), (c) allocate real regs for all regs read by this instruction. - (r_spills, r_allocd) <- - allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read + (r_spills, r_allocd) <- + allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read -- (d) Update block map for new destinations -- NB. do this before removing dead regs from the assignment, because -- these dead regs might in fact be live in the jump targets (they're -- only dead in the code that follows in the current basic block). (fixup_blocks, adjusted_instr) - <- joinToTargets block_live block_id instr + <- joinToTargets block_live block_id instr -- (e) Delete all register assignments for temps which are read -- (only) and die here. Update the free register list. @@ -415,43 +462,43 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = clobberRegs real_written -- (g) Allocate registers for temporaries *written* (only) - (w_spills, w_allocd) <- - allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written + (w_spills, w_allocd) <- + allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written -- (h) Release registers for temps which are written here and not -- used again. releaseRegs w_dying let - -- (i) Patch the instruction - patch_map - = listToUFM - [ (t, RegReal r) - | (t, r) <- zip virt_read r_allocd - ++ zip virt_written w_allocd ] + -- (i) Patch the instruction + patch_map + = listToUFM + [ (t, RegReal r) + | (t, r) <- zip virt_read r_allocd + ++ zip virt_written w_allocd ] - patched_instr - = patchRegsOfInstr adjusted_instr patchLookup + patched_instr + = patchRegsOfInstr adjusted_instr patchLookup - patchLookup x - = case lookupUFM patch_map x of - Nothing -> x - Just y -> y + patchLookup x + = case lookupUFM patch_map x of + Nothing -> x + Just y -> y -- (j) free up stack slots for dead spilled regs -- TODO (can't be bothered right now) -- erase reg->reg moves where the source and destination are the same. - -- If the src temp didn't die in this instr but happened to be allocated - -- to the same real reg as the destination, then we can erase the move anyway. - let squashed_instr = case takeRegRegMoveInstr patched_instr of - Just (src, dst) - | src == dst -> [] - _ -> [patched_instr] + -- If the src temp didn't die in this instr but happened to be allocated + -- to the same real reg as the destination, then we can erase the move anyway. + let squashed_instr = case takeRegRegMoveInstr patched_instr of + Just (src, dst) + | src == dst -> [] + _ -> [patched_instr] let code = squashed_instr ++ w_spills ++ reverse r_spills - ++ clobber_saves ++ new_instrs + ++ clobber_saves ++ new_instrs -- pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do -- pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do @@ -463,110 +510,111 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = -- ----------------------------------------------------------------------------- -- releaseRegs +releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs () releaseRegs regs = do assig <- getAssigR free <- getFreeRegsR - loop assig free regs + loop assig free regs where loop _ free _ | free `seq` False = undefined loop assig free [] = do setAssigR assig; setFreeRegsR free; return () - loop assig free (RegReal rr : rs) = loop assig (releaseReg rr free) rs - loop assig free (r:rs) = + loop assig free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs + loop assig free (r:rs) = case lookupUFM assig r of - Just (InBoth real _) -> loop (delFromUFM assig r) (releaseReg real free) rs - Just (InReg real) -> loop (delFromUFM assig r) (releaseReg real free) rs - _other -> loop (delFromUFM assig r) free rs + Just (InBoth real _) -> loop (delFromUFM assig r) (frReleaseReg real free) rs + Just (InReg real) -> loop (delFromUFM assig r) (frReleaseReg real free) rs + _other -> loop (delFromUFM assig r) free rs -- ----------------------------------------------------------------------------- -- Clobber real registers -- For each temp in a register that is going to be clobbered: --- - if the temp dies after this instruction, do nothing --- - otherwise, put it somewhere safe (another reg if possible, --- otherwise spill and record InBoth in the assignment). --- - for allocateRegs on the temps *read*, --- - clobbered regs are allocatable. +-- - if the temp dies after this instruction, do nothing +-- - otherwise, put it somewhere safe (another reg if possible, +-- otherwise spill and record InBoth in the assignment). +-- - for allocateRegs on the temps *read*, +-- - clobbered regs are allocatable. -- --- for allocateRegs on the temps *written*, --- - clobbered regs are not allocatable. +-- for allocateRegs on the temps *written*, +-- - clobbered regs are not allocatable. -- --- TODO: instead of spilling, try to copy clobbered --- temps to another register if possible. +-- TODO: instead of spilling, try to copy clobbered +-- temps to another register if possible. -- saveClobberedTemps - :: (Outputable instr, Instruction instr) - => [RealReg] -- real registers clobbered by this instruction - -> [Reg] -- registers which are no longer live after this insn - -> RegM [instr] -- return: instructions to spill any temps that will - -- be clobbered. + :: (Outputable instr, Instruction instr) + => [RealReg] -- real registers clobbered by this instruction + -> [Reg] -- registers which are no longer live after this insn + -> RegM freeRegs [instr] -- return: instructions to spill any temps that will + -- be clobbered. -saveClobberedTemps [] _ - = return [] +saveClobberedTemps [] _ + = return [] -saveClobberedTemps clobbered dying +saveClobberedTemps clobbered dying = do - assig <- getAssigR - let to_spill - = [ (temp,reg) - | (temp, InReg reg) <- ufmToList assig - , any (realRegsAlias reg) clobbered - , temp `notElem` map getUnique dying ] + assig <- getAssigR + let to_spill + = [ (temp,reg) + | (temp, InReg reg) <- ufmToList assig + , any (realRegsAlias reg) clobbered + , temp `notElem` map getUnique dying ] - (instrs,assig') <- clobber assig [] to_spill - setAssigR assig' - return instrs + (instrs,assig') <- clobber assig [] to_spill + setAssigR assig' + return instrs where - clobber assig instrs [] - = return (instrs, assig) + clobber assig instrs [] + = return (instrs, assig) - clobber assig instrs ((temp, reg) : rest) - = do - (spill, slot) <- spillR (RegReal reg) temp + clobber assig instrs ((temp, reg) : rest) + = do + (spill, slot) <- spillR (RegReal reg) temp - -- record why this reg was spilled for profiling - recordSpill (SpillClobber temp) + -- record why this reg was spilled for profiling + recordSpill (SpillClobber temp) - let new_assign = addToUFM assig temp (InBoth reg slot) + let new_assign = addToUFM assig temp (InBoth reg slot) - clobber new_assign (spill : instrs) rest + clobber new_assign (spill : instrs) rest -- | Mark all these real regs as allocated, --- and kick out their vreg assignments. +-- and kick out their vreg assignments. -- -clobberRegs :: [RealReg] -> RegM () -clobberRegs [] - = return () +clobberRegs :: FR freeRegs => [RealReg] -> RegM freeRegs () +clobberRegs [] + = return () -clobberRegs clobbered +clobberRegs clobbered = do - freeregs <- getFreeRegsR - setFreeRegsR $! foldr allocateReg freeregs clobbered + freeregs <- getFreeRegsR + setFreeRegsR $! foldr frAllocateReg freeregs clobbered - assig <- getAssigR - setAssigR $! clobber assig (ufmToList assig) + assig <- getAssigR + setAssigR $! clobber assig (ufmToList assig) where - -- if the temp was InReg and clobbered, then we will have - -- saved it in saveClobberedTemps above. So the only case - -- we have to worry about here is InBoth. Note that this - -- also catches temps which were loaded up during allocation - -- of read registers, not just those saved in saveClobberedTemps. - - clobber assig [] - = assig - - clobber assig ((temp, InBoth reg slot) : rest) - | any (realRegsAlias reg) clobbered - = clobber (addToUFM assig temp (InMem slot)) rest - - clobber assig (_:rest) - = clobber assig rest + -- if the temp was InReg and clobbered, then we will have + -- saved it in saveClobberedTemps above. So the only case + -- we have to worry about here is InBoth. Note that this + -- also catches temps which were loaded up during allocation + -- of read registers, not just those saved in saveClobberedTemps. + + clobber assig [] + = assig + + clobber assig ((temp, InBoth reg slot) : rest) + | any (realRegsAlias reg) clobbered + = clobber (addToUFM assig temp (InMem slot)) rest + + clobber assig (_:rest) + = clobber assig rest -- ----------------------------------------------------------------------------- -- allocateRegsAndSpill @@ -589,38 +637,37 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory -- the list of free registers and free stack slots. allocateRegsAndSpill - :: (Outputable instr, Instruction instr) - => Bool -- True <=> reading (load up spilled regs) - -> [VirtualReg] -- don't push these out - -> [instr] -- spill insns - -> [RealReg] -- real registers allocated (accum.) - -> [VirtualReg] -- temps to allocate - -> RegM ( [instr] - , [RealReg]) + :: (FR freeRegs, Outputable instr, Instruction instr) + => Bool -- True <=> reading (load up spilled regs) + -> [VirtualReg] -- don't push these out + -> [instr] -- spill insns + -> [RealReg] -- real registers allocated (accum.) + -> [VirtualReg] -- temps to allocate + -> RegM freeRegs ( [instr] , [RealReg]) allocateRegsAndSpill _ _ spills alloc [] - = return (spills, reverse alloc) - -allocateRegsAndSpill reading keep spills alloc (r:rs) - = do assig <- getAssigR - let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig - case lookupUFM assig r of - -- case (1a): already in a register - Just (InReg my_reg) -> - allocateRegsAndSpill reading keep spills (my_reg:alloc) rs - - -- case (1b): already in a register (and memory) - -- NB1. if we're writing this register, update its assignment to be - -- InReg, because the memory value is no longer valid. - -- NB2. This is why we must process written registers here, even if they - -- are also read by the same instruction. - Just (InBoth my_reg _) - -> do when (not reading) (setAssigR (addToUFM assig r (InReg my_reg))) - allocateRegsAndSpill reading keep spills (my_reg:alloc) rs - - -- Not already in a register, so we need to find a free one... - Just (InMem slot) | reading -> doSpill (ReadMem slot) - | otherwise -> doSpill WriteMem + = return (spills, reverse alloc) + +allocateRegsAndSpill reading keep spills alloc (r:rs) + = do assig <- getAssigR + let doSpill = allocRegsAndSpill_spill reading keep spills alloc r rs assig + case lookupUFM assig r of + -- case (1a): already in a register + Just (InReg my_reg) -> + allocateRegsAndSpill reading keep spills (my_reg:alloc) rs + + -- case (1b): already in a register (and memory) + -- NB1. if we're writing this register, update its assignment to be + -- InReg, because the memory value is no longer valid. + -- NB2. This is why we must process written registers here, even if they + -- are also read by the same instruction. + Just (InBoth my_reg _) + -> do when (not reading) (setAssigR (addToUFM assig r (InReg my_reg))) + allocateRegsAndSpill reading keep spills (my_reg:alloc) rs + + -- Not already in a register, so we need to find a free one... + Just (InMem slot) | reading -> doSpill (ReadMem slot) + | otherwise -> doSpill WriteMem Nothing | reading -> -- pprPanic "allocateRegsAndSpill: Cannot read from uninitialized register" (ppr r) -- ToDo: This case should be a panic, but we @@ -629,96 +676,106 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) -- will start with an empty assignment. doSpill WriteNew - | otherwise -> doSpill WriteNew - + | otherwise -> doSpill WriteNew + -- reading is redundant with reason, but we keep it around because it's -- convenient and it maintains the recursive structure of the allocator. -- EZY +allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr) + => Bool + -> [VirtualReg] + -> [instr] + -> [RealReg] + -> VirtualReg + -> [VirtualReg] + -> UniqFM Loc + -> SpillLoc + -> RegM freeRegs ([instr], [RealReg]) allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc = do - freeRegs <- getFreeRegsR - let freeRegs_thisClass = getFreeRegs (classOfVirtualReg r) freeRegs + freeRegs <- getFreeRegsR + let freeRegs_thisClass = frGetFreeRegs (classOfVirtualReg r) freeRegs case freeRegs_thisClass of - -- case (2): we have a free register - (my_reg : _) -> - do spills' <- loadTemp r spill_loc my_reg spills - - setAssigR (addToUFM assig r $! newLocation spill_loc my_reg) - setFreeRegsR $ allocateReg my_reg freeRegs - - allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs - - - -- case (3): we need to push something out to free up a register - [] -> - do let keep' = map getUnique keep - - -- the vregs we could kick out that are already in a slot - let candidates_inBoth - = [ (temp, reg, mem) - | (temp, InBoth reg mem) <- ufmToList assig - , temp `notElem` keep' - , targetClassOfRealReg reg == classOfVirtualReg r ] - - -- the vregs we could kick out that are only in a reg - -- this would require writing the reg to a new slot before using it. - let candidates_inReg - = [ (temp, reg) - | (temp, InReg reg) <- ufmToList assig - , temp `notElem` keep' - , targetClassOfRealReg reg == classOfVirtualReg r ] - - let result - - -- we have a temporary that is in both register and mem, - -- just free up its register for use. - | (temp, my_reg, slot) : _ <- candidates_inBoth - = do spills' <- loadTemp r spill_loc my_reg spills - let assig1 = addToUFM assig temp (InMem slot) - let assig2 = addToUFM assig1 r $! newLocation spill_loc my_reg - - setAssigR assig2 - allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs - - -- otherwise, we need to spill a temporary that currently - -- resides in a register. - | (temp_to_push_out, (my_reg :: RealReg)) : _ - <- candidates_inReg - = do - (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out - let spill_store = (if reading then id else reverse) - [ -- COMMENT (fsLit "spill alloc") - spill_insn ] - - -- record that this temp was spilled - recordSpill (SpillAlloc temp_to_push_out) - - -- update the register assignment - let assig1 = addToUFM assig temp_to_push_out (InMem slot) - let assig2 = addToUFM assig1 r $! newLocation spill_loc my_reg - setAssigR assig2 - - -- if need be, load up a spilled temp into the reg we've just freed up. - spills' <- loadTemp r spill_loc my_reg spills - - allocateRegsAndSpill reading keep - (spill_store ++ spills') - (my_reg:alloc) rs - - - -- there wasn't anything to spill, so we're screwed. - | otherwise - = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n") - $ vcat - [ text "allocating vreg: " <> text (show r) - , text "assignment: " <> text (show $ ufmToList assig) - , text "freeRegs: " <> text (show freeRegs) - , text "initFreeRegs: " <> text (show initFreeRegs) ] - - result - + -- case (2): we have a free register + (my_reg : _) -> + do spills' <- loadTemp r spill_loc my_reg spills + + setAssigR (addToUFM assig r $! newLocation spill_loc my_reg) + setFreeRegsR $ frAllocateReg my_reg freeRegs + + allocateRegsAndSpill reading keep spills' (my_reg : alloc) rs + + + -- case (3): we need to push something out to free up a register + [] -> + do let keep' = map getUnique keep + + -- the vregs we could kick out that are already in a slot + let candidates_inBoth + = [ (temp, reg, mem) + | (temp, InBoth reg mem) <- ufmToList assig + , temp `notElem` keep' + , targetClassOfRealReg reg == classOfVirtualReg r ] + + -- the vregs we could kick out that are only in a reg + -- this would require writing the reg to a new slot before using it. + let candidates_inReg + = [ (temp, reg) + | (temp, InReg reg) <- ufmToList assig + , temp `notElem` keep' + , targetClassOfRealReg reg == classOfVirtualReg r ] + + let result + + -- we have a temporary that is in both register and mem, + -- just free up its register for use. + | (temp, my_reg, slot) : _ <- candidates_inBoth + = do spills' <- loadTemp r spill_loc my_reg spills + let assig1 = addToUFM assig temp (InMem slot) + let assig2 = addToUFM assig1 r $! newLocation spill_loc my_reg + + setAssigR assig2 + allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs + + -- otherwise, we need to spill a temporary that currently + -- resides in a register. + | (temp_to_push_out, (my_reg :: RealReg)) : _ + <- candidates_inReg + = do + (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out + let spill_store = (if reading then id else reverse) + [ -- COMMENT (fsLit "spill alloc") + spill_insn ] + + -- record that this temp was spilled + recordSpill (SpillAlloc temp_to_push_out) + + -- update the register assignment + let assig1 = addToUFM assig temp_to_push_out (InMem slot) + let assig2 = addToUFM assig1 r $! newLocation spill_loc my_reg + setAssigR assig2 + + -- if need be, load up a spilled temp into the reg we've just freed up. + spills' <- loadTemp r spill_loc my_reg spills + + allocateRegsAndSpill reading keep + (spill_store ++ spills') + (my_reg:alloc) rs + + + -- there wasn't anything to spill, so we're screwed. + | otherwise + = pprPanic ("RegAllocLinear.allocRegsAndSpill: no spill candidates\n") + $ vcat + [ text "allocating vreg: " <> text (show r) + , text "assignment: " <> text (show $ ufmToList assig) + , text "freeRegs: " <> text (show freeRegs) + , text "initFreeRegs: " <> text (show (frInitFreeRegs `asTypeOf` freeRegs)) ] + + result + -- | Calculate a new location after a register has been loaded. newLocation :: SpillLoc -> RealReg -> Loc @@ -729,18 +786,18 @@ newLocation _ my_reg = InReg my_reg -- | Load up a spilled temporary if we need to (read from memory). loadTemp - :: (Outputable instr, Instruction instr) - => VirtualReg -- the temp being loaded - -> SpillLoc -- the current location of this temp - -> RealReg -- the hreg to load the temp into - -> [instr] - -> RegM [instr] + :: (Outputable instr, Instruction instr) + => VirtualReg -- the temp being loaded + -> SpillLoc -- the current location of this temp + -> RealReg -- the hreg to load the temp into + -> [instr] + -> RegM freeRegs [instr] loadTemp vreg (ReadMem slot) hreg spills = do - insn <- loadR (RegReal hreg) slot - recordSpill (SpillLoad $ getUnique vreg) - return $ {- COMMENT (fsLit "spill load") : -} insn : spills + insn <- loadR (RegReal hreg) slot + recordSpill (SpillLoad $ getUnique vreg) + return $ {- COMMENT (fsLit "spill load") : -} insn : spills loadTemp _ _ _ spills = return spills diff --git a/compiler/nativeGen/RegAlloc/Linear/State.hs b/compiler/nativeGen/RegAlloc/Linear/State.hs index 234701c..05db9de 100644 --- a/compiler/nativeGen/RegAlloc/Linear/State.hs +++ b/compiler/nativeGen/RegAlloc/Linear/State.hs @@ -32,7 +32,6 @@ where import RegAlloc.Linear.Stats import RegAlloc.Linear.StackMap import RegAlloc.Linear.Base -import RegAlloc.Linear.FreeRegs import RegAlloc.Liveness import Instruction import Reg @@ -42,19 +41,19 @@ import UniqSupply -- | The RegM Monad -instance Monad RegM where +instance Monad (RegM freeRegs) where m >>= k = RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s } return a = RegM $ \s -> (# s, a #) -- | Run a computation in the RegM register allocator monad. -runR :: BlockAssignment - -> FreeRegs +runR :: BlockAssignment freeRegs + -> freeRegs -> RegMap Loc -> StackMap -> UniqSupply - -> RegM a - -> (BlockAssignment, StackMap, RegAllocStats, a) + -> RegM freeRegs a + -> (BlockAssignment freeRegs, StackMap, RegAllocStats, a) runR block_assig freeregs assig stack us thing = case unReg thing @@ -76,14 +75,14 @@ runR block_assig freeregs assig stack us thing = -- | Make register allocator stats from its final state. -makeRAStats :: RA_State -> RegAllocStats +makeRAStats :: RA_State freeRegs -> RegAllocStats makeRAStats state = RegAllocStats { ra_spillInstrs = binSpillReasons (ra_spills state) } spillR :: Instruction instr - => Reg -> Unique -> RegM (instr, Int) + => Reg -> Unique -> RegM freeRegs (instr, Int) spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} -> let (stack',slot) = getStackSlotFor stack temp @@ -93,49 +92,49 @@ spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} -> loadR :: Instruction instr - => Reg -> Int -> RegM instr + => Reg -> Int -> RegM freeRegs instr loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} -> (# s, mkLoadInstr reg delta slot #) -getFreeRegsR :: RegM FreeRegs +getFreeRegsR :: RegM freeRegs freeRegs getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} -> (# s, freeregs #) -setFreeRegsR :: FreeRegs -> RegM () +setFreeRegsR :: freeRegs -> RegM freeRegs () setFreeRegsR regs = RegM $ \ s -> (# s{ra_freeregs = regs}, () #) -getAssigR :: RegM (RegMap Loc) +getAssigR :: RegM freeRegs (RegMap Loc) getAssigR = RegM $ \ s@RA_State{ra_assig = assig} -> (# s, assig #) -setAssigR :: RegMap Loc -> RegM () +setAssigR :: RegMap Loc -> RegM freeRegs () setAssigR assig = RegM $ \ s -> (# s{ra_assig=assig}, () #) -getBlockAssigR :: RegM BlockAssignment +getBlockAssigR :: RegM freeRegs (BlockAssignment freeRegs) getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} -> (# s, assig #) -setBlockAssigR :: BlockAssignment -> RegM () +setBlockAssigR :: BlockAssignment freeRegs -> RegM freeRegs () setBlockAssigR assig = RegM $ \ s -> (# s{ra_blockassig = assig}, () #) -setDeltaR :: Int -> RegM () +setDeltaR :: Int -> RegM freeRegs () setDeltaR n = RegM $ \ s -> (# s{ra_delta = n}, () #) -getDeltaR :: RegM Int +getDeltaR :: RegM freeRegs Int getDeltaR = RegM $ \s -> (# s, ra_delta s #) -getUniqueR :: RegM Unique +getUniqueR :: RegM freeRegs Unique getUniqueR = RegM $ \s -> case takeUniqFromSupply (ra_us s) of (uniq, us) -> (# s{ra_us = us}, uniq #) -- | Record that a spill instruction was inserted, for profiling. -recordSpill :: SpillReason -> RegM () +recordSpill :: SpillReason -> RegM freeRegs () recordSpill spill = RegM $ \s -> (# s { ra_spills = spill : ra_spills s}, () #) diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs index 106b673..0a26c23 100644 --- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs +++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs @@ -80,9 +80,19 @@ genCCall (CmmPrim (MO_WriteBarrier)) _ _ genCCall target dest_regs argsAndHints = do + -- need to remove alignment information + let argsAndHints' | (CmmPrim mop) <- target, + (mop == MO_Memcpy || + mop == MO_Memset || + mop == MO_Memmove) + = init argsAndHints + + | otherwise + = argsAndHints + -- strip hints from the arg regs let args :: [CmmExpr] - args = map hintlessCmm argsAndHints + args = map hintlessCmm argsAndHints' -- work out the arguments, and assign them to integer regs @@ -104,7 +114,7 @@ genCCall target dest_regs argsAndHints return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False) CmmPrim mop - -> do res <- outOfLineFloatOp mop + -> do res <- outOfLineMachOp mop lblOrMopExpr <- case res of Left lbl -> do return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False)) @@ -253,13 +263,13 @@ assign_code _ -- | Generate a call to implement an out-of-line floating point operation -outOfLineFloatOp +outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr) -outOfLineFloatOp mop +outOfLineMachOp mop = do let functionName - = outOfLineFloatOp_table mop + = outOfLineMachOp_table mop dflags <- getDynFlagsNat mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference @@ -275,11 +285,11 @@ outOfLineFloatOp mop -- | Decide what C function to use to implement a CallishMachOp -- -outOfLineFloatOp_table +outOfLineMachOp_table :: CallishMachOp -> FastString -outOfLineFloatOp_table mop +outOfLineMachOp_table mop = case mop of MO_F32_Exp -> fsLit "expf" MO_F32_Log -> fsLit "logf" @@ -315,5 +325,9 @@ outOfLineFloatOp_table mop MO_F64_Cosh -> fsLit "cosh" MO_F64_Tanh -> fsLit "tanh" - _ -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op " + MO_Memcpy -> fsLit "memcpy" + MO_Memset -> fsLit "memset" + MO_Memmove -> fsLit "memmove" + + _ -> pprPanic "outOfLineMachOp(sparc): Unknown callish mach op " (pprCallishMachOp mop) diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index c5a3314..d78d1a7 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -101,9 +101,7 @@ pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> Doc pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext IF_ARCH_sparc((sLit ".global "), - (sLit ".globl ")) <> - pprCLabel_asm lbl + | otherwise = ptext (sLit ".global ") <> pprCLabel_asm lbl pprTypeAndSizeDecl :: CLabel -> Doc #if linux_TARGET_OS diff --git a/compiler/nativeGen/SPARC/ShortcutJump.hs b/compiler/nativeGen/SPARC/ShortcutJump.hs index c0c3343..30e48bb 100644 --- a/compiler/nativeGen/SPARC/ShortcutJump.hs +++ b/compiler/nativeGen/SPARC/ShortcutJump.hs @@ -1,6 +1,6 @@ module SPARC.ShortcutJump ( - JumpDest(..), + JumpDest(..), getJumpDestBlockId, canShortcut, shortcutJump, shortcutStatic, @@ -25,6 +25,10 @@ data JumpDest = DestBlockId BlockId | DestImm Imm +getJumpDestBlockId :: JumpDest -> Maybe BlockId +getJumpDestBlockId (DestBlockId bid) = Just bid +getJumpDestBlockId _ = Nothing + canShortcut :: Instr -> Maybe JumpDest canShortcut _ = Nothing diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index 35b49d1..b357675 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -31,60 +31,72 @@ import CmmType (wordWidth) import Outputable import Unique import FastTypes +import Platform +import qualified X86.Regs as X86 +import qualified X86.RegInfo as X86 -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -import qualified X86.Regs as X86 -import qualified X86.RegInfo as X86 +import qualified PPC.Regs as PPC -#elif powerpc_TARGET_ARCH -import qualified PPC.Regs as PPC +import qualified SPARC.Regs as SPARC -#elif sparc_TARGET_ARCH -import qualified SPARC.Regs as SPARC - -#else -#error "RegAlloc.Graph.TargetReg: not defined" -#endif +-- TODO: We shouldn't be using defaultTargetPlatform here. +-- We should be passing DynFlags in instead, and looking at +-- its targetPlatform. targetVirtualRegSqueeze :: RegClass -> VirtualReg -> FastInt -targetRealRegSqueeze :: RegClass -> RealReg -> FastInt -targetClassOfRealReg :: RealReg -> RegClass -targetWordSize :: Size -targetMkVirtualReg :: Unique -> Size -> VirtualReg -targetRegDotColor :: RealReg -> SDoc - --- x86 ------------------------------------------------------------------------- -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH -targetVirtualRegSqueeze = X86.virtualRegSqueeze -targetRealRegSqueeze = X86.realRegSqueeze -targetClassOfRealReg = X86.classOfRealReg -targetWordSize = intSize wordWidth -targetMkVirtualReg = X86.mkVirtualReg -targetRegDotColor = X86.regDotColor - --- ppc ------------------------------------------------------------------------- -#elif powerpc_TARGET_ARCH -targetVirtualRegSqueeze = PPC.virtualRegSqueeze -targetRealRegSqueeze = PPC.realRegSqueeze -targetClassOfRealReg = PPC.classOfRealReg -targetWordSize = intSize wordWidth -targetMkVirtualReg = PPC.mkVirtualReg -targetRegDotColor = PPC.regDotColor - --- sparc ----------------------------------------------------------------------- -#elif sparc_TARGET_ARCH -targetVirtualRegSqueeze = SPARC.virtualRegSqueeze -targetRealRegSqueeze = SPARC.realRegSqueeze -targetClassOfRealReg = SPARC.classOfRealReg -targetWordSize = intSize wordWidth -targetMkVirtualReg = SPARC.mkVirtualReg -targetRegDotColor = SPARC.regDotColor - --------------------------------------------------------------------------------- -#else -#error "RegAlloc.Graph.TargetReg: not defined" -#endif +targetVirtualRegSqueeze + = case platformArch defaultTargetPlatform of + ArchX86 -> X86.virtualRegSqueeze + ArchX86_64 -> X86.virtualRegSqueeze + ArchPPC -> PPC.virtualRegSqueeze + ArchSPARC -> SPARC.virtualRegSqueeze + ArchPPC_64 -> panic "targetVirtualRegSqueeze ArchPPC_64" + ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown" + +targetRealRegSqueeze :: RegClass -> RealReg -> FastInt +targetRealRegSqueeze + = case platformArch defaultTargetPlatform of + ArchX86 -> X86.realRegSqueeze + ArchX86_64 -> X86.realRegSqueeze + ArchPPC -> PPC.realRegSqueeze + ArchSPARC -> SPARC.realRegSqueeze + ArchPPC_64 -> panic "targetRealRegSqueeze ArchPPC_64" + ArchUnknown -> panic "targetRealRegSqueeze ArchUnknown" + +targetClassOfRealReg :: RealReg -> RegClass +targetClassOfRealReg + = case platformArch defaultTargetPlatform of + ArchX86 -> X86.classOfRealReg + ArchX86_64 -> X86.classOfRealReg + ArchPPC -> PPC.classOfRealReg + ArchSPARC -> SPARC.classOfRealReg + ArchPPC_64 -> panic "targetClassOfRealReg ArchPPC_64" + ArchUnknown -> panic "targetClassOfRealReg ArchUnknown" + +-- TODO: This should look at targetPlatform too +targetWordSize :: Size +targetWordSize = intSize wordWidth + +targetMkVirtualReg :: Unique -> Size -> VirtualReg +targetMkVirtualReg + = case platformArch defaultTargetPlatform of + ArchX86 -> X86.mkVirtualReg + ArchX86_64 -> X86.mkVirtualReg + ArchPPC -> PPC.mkVirtualReg + ArchSPARC -> SPARC.mkVirtualReg + ArchPPC_64 -> panic "targetMkVirtualReg ArchPPC_64" + ArchUnknown -> panic "targetMkVirtualReg ArchUnknown" + +targetRegDotColor :: RealReg -> SDoc +targetRegDotColor + = case platformArch defaultTargetPlatform of + ArchX86 -> X86.regDotColor + ArchX86_64 -> X86.regDotColor + ArchPPC -> PPC.regDotColor + ArchSPARC -> SPARC.regDotColor + ArchPPC_64 -> panic "targetRegDotColor ArchPPC_64" + ArchUnknown -> panic "targetRegDotColor ArchUnknown" targetClassOfReg :: Reg -> RegClass diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index a6cc36f..2f3e139 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1,10 +1,3 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - ----------------------------------------------------------------------------- -- -- Generating machine code (instruction selection) @@ -35,30 +28,25 @@ import X86.Instr import X86.Cond import X86.Regs import X86.RegInfo -import X86.Ppr import Instruction import PIC import NCGMonad import Size import Reg -import RegClass import Platform -- Our intermediate code: import BasicTypes import BlockId -import PprCmm ( pprExpr ) +import PprCmm () import OldCmm -import OldPprCmm +import OldPprCmm () import CLabel -import ClosureInfo ( C_SRT(..) ) -- The rest: import StaticFlags ( opt_PIC ) import ForeignCall ( CCallConv(..) ) import OrdList -import Pretty -import qualified Outputable as O import Outputable import Unique import FastString @@ -66,13 +54,15 @@ import FastBool ( isFastTrue ) import Constants ( wORD_SIZE ) import DynFlags -import Debug.Trace ( trace ) +import Control.Monad ( mapAndUnzipM ) +import Data.Maybe ( catMaybes ) +import Data.Int -import Control.Monad ( mapAndUnzipM ) -import Data.Maybe ( fromJust ) -import Data.Bits +#if WORD_SIZE_IN_BITS==32 +import Data.Maybe ( fromJust ) import Data.Word -import Data.Int +import Data.Bits +#endif sse2Enabled :: NatM Bool #if x86_64_TARGET_ARCH @@ -170,8 +160,8 @@ stmtToInstrs stmt = case stmt of CmmBranch id -> genBranch id CmmCondBranch arg id -> genCondJump id arg CmmSwitch arg ids -> genSwitch arg ids - CmmJump arg params -> genJump arg - CmmReturn params -> + CmmJump arg _ -> genJump arg + CmmReturn _ -> panic "stmtToInstrs: return statement should have been cps'd away" @@ -190,6 +180,7 @@ data CondCode = CondCode Bool Cond InstrBlock +#if WORD_SIZE_IN_BITS==32 -- | a.k.a "Register64" -- Reg is the lower 32-bit temporary which contains the result. -- Use getHiVRegFromLo to find the other VRegUnique. @@ -201,6 +192,7 @@ data ChildCode64 = ChildCode64 InstrBlock Reg +#endif -- | Register's passed up the tree. If the stix code forces the register @@ -282,8 +274,8 @@ jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel) -- Expand CmmRegOff. ToDo: should we do it this way around, or convert -- CmmExprs into CmmRegOff? -mangleIndexTree :: CmmExpr -> CmmExpr -mangleIndexTree (CmmRegOff reg off) +mangleIndexTree :: CmmReg -> Int -> CmmExpr +mangleIndexTree reg off = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] where width = typeWidth (cmmRegType reg) @@ -300,9 +292,7 @@ getSomeReg expr = do return (reg, code) - - - +#if WORD_SIZE_IN_BITS==32 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock assignMem_I64Code addrTree valueTree = do Amode addr addr_code <- getAmode addrTree @@ -318,7 +308,7 @@ assignMem_I64Code addrTree valueTree = do assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock -assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do +assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree let r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32 @@ -331,12 +321,10 @@ assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do vcode `snocOL` mov_lo `snocOL` mov_hi ) -assignReg_I64Code lvalue valueTree +assignReg_I64Code _ _ = panic "assignReg_I64Code(i386): invalid lvalue" - - iselExpr64 :: CmmExpr -> NatM ChildCode64 iselExpr64 (CmmLit (CmmInt i _)) = do (rlo,rhi) <- getNewRegPairNat II32 @@ -410,7 +398,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do iselExpr64 expr = pprPanic "iselExpr64(i386)" (ppr expr) - +#endif -------------------------------------------------------------------------------- @@ -435,8 +423,8 @@ getRegister (CmmReg reg) return (Fixed size (getRegisterReg use_sse2 reg) nilOL) -getRegister tree@(CmmRegOff _ _) - = getRegister (mangleIndexTree tree) +getRegister (CmmRegOff r n) + = getRegister $ mangleIndexTree r n #if WORD_SIZE_IN_BITS==32 @@ -611,7 +599,7 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps MO_FS_Conv from to -> coerceFP2Int from to x MO_SF_Conv from to -> coerceInt2FP from to x - other -> pprPanic "getRegister" (pprMachOp mop) + _other -> pprPanic "getRegister" (pprMachOp mop) where triv_ucode :: (Size -> Operand -> Instr) -> Size -> NatM Register triv_ucode instr size = trivialUCode size (instr size) x @@ -648,37 +636,37 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps return (swizzleRegisterRep e_code new_size) -getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps +getRegister (CmmMachOp mop [x, y]) = do -- dyadic MachOps sse2 <- sse2Enabled case mop of - MO_F_Eq w -> condFltReg EQQ x y - MO_F_Ne w -> condFltReg NE x y - MO_F_Gt w -> condFltReg GTT x y - MO_F_Ge w -> condFltReg GE x y - MO_F_Lt w -> condFltReg LTT x y - MO_F_Le w -> condFltReg LE x y - - MO_Eq rep -> condIntReg EQQ x y - MO_Ne rep -> condIntReg NE x y - - MO_S_Gt rep -> condIntReg GTT x y - MO_S_Ge rep -> condIntReg GE x y - MO_S_Lt rep -> condIntReg LTT x y - MO_S_Le rep -> condIntReg LE x y - - MO_U_Gt rep -> condIntReg GU x y - MO_U_Ge rep -> condIntReg GEU x y - MO_U_Lt rep -> condIntReg LU x y - MO_U_Le rep -> condIntReg LEU x y + MO_F_Eq _ -> condFltReg EQQ x y + MO_F_Ne _ -> condFltReg NE x y + MO_F_Gt _ -> condFltReg GTT x y + MO_F_Ge _ -> condFltReg GE x y + MO_F_Lt _ -> condFltReg LTT x y + MO_F_Le _ -> condFltReg LE x y + + MO_Eq _ -> condIntReg EQQ x y + MO_Ne _ -> condIntReg NE x y + + MO_S_Gt _ -> condIntReg GTT x y + MO_S_Ge _ -> condIntReg GE x y + MO_S_Lt _ -> condIntReg LTT x y + MO_S_Le _ -> condIntReg LE x y + + MO_U_Gt _ -> condIntReg GU x y + MO_U_Ge _ -> condIntReg GEU x y + MO_U_Lt _ -> condIntReg LU x y + MO_U_Le _ -> condIntReg LEU x y MO_F_Add w | sse2 -> trivialFCode_sse2 w ADD x y - | otherwise -> trivialFCode_x87 w GADD x y + | otherwise -> trivialFCode_x87 GADD x y MO_F_Sub w | sse2 -> trivialFCode_sse2 w SUB x y - | otherwise -> trivialFCode_x87 w GSUB x y + | otherwise -> trivialFCode_x87 GSUB x y MO_F_Quot w | sse2 -> trivialFCode_sse2 w FDIV x y - | otherwise -> trivialFCode_x87 w GDIV x y + | otherwise -> trivialFCode_x87 GDIV x y MO_F_Mul w | sse2 -> trivialFCode_sse2 w MUL x y - | otherwise -> trivialFCode_x87 w GMUL x y + | otherwise -> trivialFCode_x87 GMUL x y MO_Add rep -> add_code rep x y MO_Sub rep -> sub_code rep x y @@ -703,7 +691,7 @@ getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps MO_U_Shr rep -> shift_code rep SHR x y {-False-} MO_S_Shr rep -> shift_code rep SAR x y {-False-} - other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop) + _other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop) where -------------------- triv_op width instr = trivialCode width op (Just op) x y @@ -740,7 +728,7 @@ getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps -> NatM Register {- Case1: shift length as immediate -} - shift_code width instr x y@(CmmLit lit) = do + shift_code width instr x (CmmLit lit) = do x_code <- getAnyReg x let size = intSize width @@ -866,8 +854,7 @@ getRegister (CmmLit (CmmInt 0 width)) size = intSize width -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits - adj_size = case size of II64 -> II32; _ -> size - size1 = IF_ARCH_i386( size, adj_size ) + size1 = IF_ARCH_i386( size, case size of II64 -> II32; _ -> size ) code dst = unitOL (XOR size1 (OpReg dst) (OpReg dst)) in @@ -971,7 +958,7 @@ reg2reg size src dst -------------------------------------------------------------------------------- getAmode :: CmmExpr -> NatM Amode -getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree) +getAmode (CmmRegOff r n) = getAmode $ mangleIndexTree r n #if x86_64_TARGET_ARCH @@ -984,14 +971,14 @@ getAmode (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg), -- This is all just ridiculous, since it carefully undoes -- what mangleIndexTree has just done. -getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)]) +getAmode (CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)]) | is32BitLit lit -- ASSERT(rep == II32)??? = do (x_reg, x_code) <- getSomeReg x let off = ImmInt (-(fromInteger i)) return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) -getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit]) +getAmode (CmmMachOp (MO_Add _rep) [x, CmmLit lit]) | is32BitLit lit -- ASSERT(rep == II32)??? = do (x_reg, x_code) <- getSomeReg x @@ -1004,12 +991,12 @@ getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)]) = getAmode (CmmMachOp (MO_Add rep) [b,a]) -getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _) +getAmode (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]]) | shift == 0 || shift == 1 || shift == 2 || shift == 3 = x86_complex_amode x y shift 0 -getAmode (CmmMachOp (MO_Add rep) +getAmode (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]]) @@ -1017,7 +1004,7 @@ getAmode (CmmMachOp (MO_Add rep) && is32BitInteger offset = x86_complex_amode x y shift offset -getAmode (CmmMachOp (MO_Add rep) [x,y]) +getAmode (CmmMachOp (MO_Add _) [x,y]) = x86_complex_amode x y 0 0 getAmode (CmmLit lit) | is32BitLit lit @@ -1036,7 +1023,8 @@ x86_complex_amode base index shift offset (y_reg, y_code) <- getSomeReg index let code = x_code `appOL` y_code - base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8 + base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8; + n -> panic $ "x86_complex_amode: unhandled shift! (" ++ show n ++ ")" return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset))) code) @@ -1093,6 +1081,7 @@ getNonClobberedOperand_generic e = do amodeCouldBeClobbered :: AddrMode -> Bool amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode) +regClobbered :: Reg -> Bool regClobbered (RegReal (RealRegSingle rr)) = isFastTrue (freeReg rr) regClobbered _ = False @@ -1124,6 +1113,7 @@ getOperand (CmmLoad mem pk) = do getOperand e = getOperand_generic e +getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) getOperand_generic e = do (reg, code) <- getSomeReg e return (OpReg reg, code) @@ -1170,6 +1160,7 @@ loadFloatAmode use_sse2 w addr addr_code = do -- use it directly from memory. However, if the literal is -- zero, we're better off generating it into a register using -- xor. +isSuitableFloatingPointLit :: CmmLit -> Bool isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0 isSuitableFloatingPointLit _ = False @@ -1187,12 +1178,13 @@ getRegOrMem e = do (reg, code) <- getNonClobberedReg e return (OpReg reg, code) +is32BitLit :: CmmLit -> Bool #if x86_64_TARGET_ARCH is32BitLit (CmmInt i W64) = is32BitInteger i -- assume that labels are in the range 0-2^31-1: this assumes the -- small memory model (see gcc docs, -mcmodel=small). #endif -is32BitLit x = True +is32BitLit _ = True @@ -1220,20 +1212,20 @@ getCondCode (CmmMachOp mop [x, y]) MO_F_Lt W64 -> condFltCode LTT x y MO_F_Le W64 -> condFltCode LE x y - MO_Eq rep -> condIntCode EQQ x y - MO_Ne rep -> condIntCode NE x y + MO_Eq _ -> condIntCode EQQ x y + MO_Ne _ -> condIntCode NE x y - MO_S_Gt rep -> condIntCode GTT x y - MO_S_Ge rep -> condIntCode GE x y - MO_S_Lt rep -> condIntCode LTT x y - MO_S_Le rep -> condIntCode LE x y + MO_S_Gt _ -> condIntCode GTT x y + MO_S_Ge _ -> condIntCode GE x y + MO_S_Lt _ -> condIntCode LTT x y + MO_S_Le _ -> condIntCode LE x y - MO_U_Gt rep -> condIntCode GU x y - MO_U_Ge rep -> condIntCode GEU x y - MO_U_Lt rep -> condIntCode LU x y - MO_U_Le rep -> condIntCode LEU x y + MO_U_Gt _ -> condIntCode GU x y + MO_U_Ge _ -> condIntCode GEU x y + MO_U_Lt _ -> condIntCode LU x y + MO_U_Le _ -> condIntCode LEU x y - other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y])) + _other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y])) getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other) @@ -1257,8 +1249,8 @@ condIntCode cond (CmmLoad x pk) (CmmLit lit) | is32BitLit lit = do -- anything vs zero, using a mask -- TODO: Add some sanity checking!!!! -condIntCode cond (CmmMachOp (MO_And rep) [x,o2]) (CmmLit (CmmInt 0 pk)) - | (CmmLit lit@(CmmInt mask pk2)) <- o2, is32BitLit lit +condIntCode cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 pk)) + | (CmmLit lit@(CmmInt mask _)) <- o2, is32BitLit lit = do (x_reg, x_code) <- getSomeReg x let @@ -1310,7 +1302,6 @@ condFltCode cond x y = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do (x_reg, x_code) <- getNonClobberedReg x (y_reg, y_code) <- getSomeReg y - use_sse2 <- sse2Enabled let code = x_code `appOL` y_code `snocOL` GCMP cond x_reg y_reg @@ -1400,7 +1391,7 @@ assignReg_IntCode pk reg (CmmLoad src _) = do return (load_code (getRegisterReg False{-no sse2-} reg)) -- dst is a reg, but src could be anything -assignReg_IntCode pk reg src = do +assignReg_IntCode _ reg src = do code <- getAnyReg src return (code (getRegisterReg False{-no sse2-} reg)) @@ -1418,7 +1409,7 @@ assignMem_FltCode pk addr src = do return code -- Floating point assignment to a register/temporary -assignReg_FltCode pk reg src = do +assignReg_FltCode _ reg src = do use_sse2 <- sse2Enabled src_code <- getAnyReg src return (src_code (getRegisterReg use_sse2 reg)) @@ -1426,7 +1417,7 @@ assignReg_FltCode pk reg src = do genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock -genJump (CmmLoad mem pk) = do +genJump (CmmLoad mem _) = do Amode target code <- getAmode mem return (code `snocOL` JMP (OpAddr target)) @@ -1519,14 +1510,18 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- write barrier compiles to no code on x86/x86-64; -- we keep it this long in order to prevent earlier optimisations. +-- void return type prim op +genCCall (CmmPrim op) [] args = + outOfLineCmmOp op Nothing args + -- we only cope with a single result for foreign calls -genCCall (CmmPrim op) [CmmHinted r _] args = do +genCCall (CmmPrim op) [r_hinted@(CmmHinted r _)] args = do l1 <- getNewLabelNat l2 <- getNewLabelNat sse2 <- sse2Enabled if sse2 then - outOfLineFloatOp op r args + outOfLineCmmOp op (Just r_hinted) args else case op of MO_F32_Sqrt -> actuallyInlineFloatOp GSQRT FF32 args MO_F64_Sqrt -> actuallyInlineFloatOp GSQRT FF64 args @@ -1540,14 +1535,18 @@ genCCall (CmmPrim op) [CmmHinted r _] args = do MO_F32_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF32 args MO_F64_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF64 args - other_op -> outOfLineFloatOp op r args + _other_op -> outOfLineCmmOp op (Just r_hinted) args where actuallyInlineFloatOp instr size [CmmHinted x _] - = do res <- trivialUFCode size (instr size) x + = do res <- trivialUFCode size (instr size) x any <- anyReg res return (any (getRegisterReg False (CmmLocal r))) + actuallyInlineFloatOp _ _ args + = panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! (" + ++ show (length args) ++ ")" + genCCall target dest_regs args = do let sizes = map (arg_size . cmmExprType . hintlessCmm) (reverse args) @@ -1569,7 +1568,6 @@ genCCall target dest_regs args = do -- deal with static vs dynamic call targets (callinsns,cconv) <- case target of - -- CmmPrim -> ... CmmCallee (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes return (unitOL (CALL (Left fn_imm) []), conv) @@ -1578,6 +1576,9 @@ genCCall target dest_regs args = do -> do { (dyn_r, dyn_c) <- getSomeReg expr ; ASSERT( isWord32 (cmmExprType expr) ) return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) } + CmmPrim _ + -> panic $ "genCCall: Can't handle CmmPrim call type here, error " + ++ "probably because too many return values." let push_code #if darwin_TARGET_OS @@ -1646,9 +1647,10 @@ genCCall target dest_regs args = do arg_size :: CmmType -> Int -- Width in bytes arg_size ty = widthInBytes (typeWidth ty) +#if darwin_TARGET_OS roundTo a x | x `mod` a == 0 = x | otherwise = x + a - (x `mod` a) - +#endif push_arg :: Bool -> HintedCmmActual {-current argument-} -> NatM InstrBlock -- code @@ -1703,9 +1705,13 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- write barrier compiles to no code on x86/x86-64; -- we keep it this long in order to prevent earlier optimisations. +-- void return type prim op +genCCall (CmmPrim op) [] args = + outOfLineCmmOp op Nothing args -genCCall (CmmPrim op) [CmmHinted r _] args = - outOfLineFloatOp op r args +-- we only cope with a single result for foreign calls +genCCall (CmmPrim op) [res] args = + outOfLineCmmOp op (Just res) args genCCall target dest_regs args = do @@ -1749,7 +1755,6 @@ genCCall target dest_regs args = do -- deal with static vs dynamic call targets (callinsns,cconv) <- case target of - -- CmmPrim -> ... CmmCallee (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes return (unitOL (CALL (Left fn_imm) arg_regs), conv) @@ -1757,6 +1762,9 @@ genCCall target dest_regs args = do CmmCallee expr conv -> do (dyn_r, dyn_c) <- getSomeReg expr return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv) + CmmPrim _ + -> panic $ "genCCall: Can't handle CmmPrim call type here, error " + ++ "probably because too many return values." let -- The x86_64 ABI requires us to set %al to the number of SSE2 @@ -1792,7 +1800,7 @@ genCCall target dest_regs args = do where rep = localRegType dest r_dest = getRegisterReg True (CmmLocal dest) - assign_code many = panic "genCCall.assign_code many" + assign_code _many = panic "genCCall.assign_code many" return (load_args_code `appOL` adjust_rsp `appOL` @@ -1834,7 +1842,7 @@ genCCall target dest_regs args = do return ((CmmHinted arg hint):args', ars, frs, code') push_args [] code = return code - push_args ((CmmHinted arg hint):rest) code + push_args ((CmmHinted arg _):rest) code | isFloatType arg_rep = do (arg_reg, arg_code) <- getSomeReg arg delta <- getDeltaNat @@ -1867,22 +1875,26 @@ genCCall = panic "X86.genCCAll: not defined" #endif /* x86_64_TARGET_ARCH */ - - -outOfLineFloatOp :: CallishMachOp -> CmmFormal -> HintedCmmActuals -> NatM InstrBlock -outOfLineFloatOp mop res args +outOfLineCmmOp :: CallishMachOp -> Maybe HintedCmmFormal -> HintedCmmActuals -> NatM InstrBlock +outOfLineCmmOp mop res args = do dflags <- getDynFlagsNat targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl let target = CmmCallee targetExpr CCallConv - stmtToInstrs (CmmCall target [CmmHinted res NoHint] args CmmUnsafe CmmMayReturn) + stmtToInstrs (CmmCall target (catMaybes [res]) args' CmmUnsafe CmmMayReturn) where -- Assume we can call these functions directly, and that they're not in a dynamic library. -- TODO: Why is this ok? Under linux this code will be in libm.so -- Is is because they're really implemented as a primitive instruction by the assembler?? -- BL 2009/12/31 lbl = mkForeignLabel fn Nothing ForeignLabelInThisPackage IsFunction + args' = case mop of + MO_Memcpy -> init args + MO_Memset -> init args + MO_Memmove -> init args + _ -> args + fn = case mop of MO_F32_Sqrt -> fsLit "sqrtf" MO_F32_Sin -> fsLit "sinf" @@ -1916,8 +1928,11 @@ outOfLineFloatOp mop res args MO_F64_Tanh -> fsLit "tanh" MO_F64_Pwr -> fsLit "pow" + MO_Memcpy -> fsLit "memcpy" + MO_Memset -> fsLit "memset" + MO_Memmove -> fsLit "memmove" - + other -> panic $ "outOfLineCmmOp: unmatched op! (" ++ show other ++ ")" -- ----------------------------------------------------------------------------- @@ -1956,10 +1971,7 @@ genSwitch expr ids -- conjunction with the hack in PprMach.hs/pprDataItem once -- binutils 2.17 is standard. code = e_code `appOL` t_code `appOL` toOL [ - MOVSxL II32 - (OpAddr (AddrBaseIndex (EABaseReg tableReg) - (EAIndex reg wORD_SIZE) (ImmInt 0))) - (OpReg reg), + MOVSxL II32 op (OpReg reg), ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg), JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] @@ -1975,8 +1987,7 @@ genSwitch expr ids = do (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat - let - op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) + let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) code = e_code `appOL` toOL [ JMP_TBL op ids ReadOnlyData lbl ] @@ -1987,6 +1998,7 @@ generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr) generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl) generateJumpTableForInstr _ = Nothing +createJumpTable :: [Maybe BlockId] -> Section -> CLabel -> GenCmmTop CmmStatic h g createJumpTable ids section lbl = let jumpTable | opt_PIC = @@ -2142,7 +2154,10 @@ SDM's version of The Rules: register happens to be the destination register. -} -trivialCode width instr (Just revinstr) (CmmLit lit_a) b +trivialCode :: Width -> (Operand -> Operand -> Instr) + -> Maybe (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialCode width _ (Just revinstr) (CmmLit lit_a) b | is32BitLit lit_a = do b_code <- getAnyReg b let @@ -2152,10 +2167,12 @@ trivialCode width instr (Just revinstr) (CmmLit lit_a) b -- in return (Any (intSize width) code) -trivialCode width instr maybe_revinstr a b +trivialCode width instr _ a b = genTrivialCode (intSize width) instr a b -- This is re-used for floating pt instructions too. +genTrivialCode :: Size -> (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register genTrivialCode rep instr a b = do (b_op, b_code) <- getNonClobberedOperand b a_code <- getAnyReg a @@ -2180,12 +2197,15 @@ genTrivialCode rep instr a b = do -- in return (Any rep code) +regClashesWithOp :: Reg -> Operand -> Bool reg `regClashesWithOp` OpReg reg2 = reg == reg2 reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode) -reg `regClashesWithOp` _ = False +_ `regClashesWithOp` _ = False ----------- +trivialUCode :: Size -> (Operand -> Instr) + -> CmmExpr -> NatM Register trivialUCode rep instr x = do x_code <- getAnyReg x let @@ -2196,7 +2216,9 @@ trivialUCode rep instr x = do ----------- -trivialFCode_x87 width instr x y = do +trivialFCode_x87 :: (Size -> Reg -> Reg -> Reg -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialFCode_x87 instr x y = do (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too (y_reg, y_code) <- getSomeReg y let @@ -2207,11 +2229,14 @@ trivialFCode_x87 width instr x y = do instr size x_reg y_reg dst return (Any size code) +trivialFCode_sse2 :: Width -> (Size -> Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register trivialFCode_sse2 pk instr x y = genTrivialCode size (instr size) x y where size = floatSize pk +trivialUFCode :: Size -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register trivialUFCode size instr x = do (x_reg, x_code) <- getSomeReg x let @@ -2229,7 +2254,9 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 coerce_x87 = do (x_reg, x_code) <- getSomeReg x let - opc = case to of W32 -> GITOF; W64 -> GITOD + opc = case to of W32 -> GITOF; W64 -> GITOD; + n -> panic $ "coerceInt2FP.x87: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc x_reg dst -- ToDo: works for non-II32 reps? return (Any FF80 code) @@ -2238,6 +2265,8 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand let opc = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD + n -> panic $ "coerceInt2FP.sse: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc (intSize from) x_op dst -- in return (Any (floatSize to) code) @@ -2251,6 +2280,8 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 (x_reg, x_code) <- getSomeReg x let opc = case from of W32 -> GFTOI; W64 -> GDTOI + n -> panic $ "coerceFP2Int.x87: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc x_reg dst -- ToDo: works for non-II32 reps? -- in @@ -2259,7 +2290,9 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 coerceFP2Int_sse2 = do (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand let - opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ + opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ; + n -> panic $ "coerceFP2Init.sse: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc (intSize to) x_op dst -- in return (Any (intSize to) code) @@ -2272,7 +2305,9 @@ coerceFP2FP to x = do use_sse2 <- sse2Enabled (x_reg, x_code) <- getSomeReg x let - opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD + opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD; + n -> panic $ "coerceFP2FP: unhandled width (" + ++ show n ++ ")" | otherwise = GDTOF code dst = x_code `snocOL` opc x_reg dst -- in diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index 92655d1..b9c851a 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -781,6 +781,9 @@ is_G_instr instr data JumpDest = DestBlockId BlockId | DestImm Imm +getJumpDestBlockId :: JumpDest -> Maybe BlockId +getJumpDestBlockId (DestBlockId bid) = Just bid +getJumpDestBlockId _ = Nothing canShortcut :: Instr -> Maybe JumpDest canShortcut (JXX ALWAYS id) = Just (DestBlockId id) diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 38b6344..769057a 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -118,9 +118,7 @@ pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> Doc pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext IF_ARCH_sparc((sLit ".global "), - (sLit ".globl ")) <> - pprCLabel_asm lbl + | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl pprTypeAndSizeDecl :: CLabel -> Doc #if elf_OBJ_FORMAT @@ -492,15 +490,7 @@ pprInstr :: Instr -> Doc pprInstr (COMMENT _) = empty -- nuke 'em {- -pprInstr (COMMENT s) - = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s)) - ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s)) - ,IF_ARCH_powerpc( IF_OS_linux( - ((<>) (ptext (sLit "# ")) (ftext s)), - ((<>) (ptext (sLit "; ")) (ftext s))) - ,))))) +pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s -} pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index 21b594e..140ff57 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -13,12 +13,11 @@ import Size import Reg import Outputable +import Platform import Unique -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH import UniqFM import X86.Regs -#endif mkVirtualReg :: Unique -> Size -> VirtualReg @@ -29,52 +28,41 @@ mkVirtualReg u size FF80 -> VirtualRegD u _other -> VirtualRegI u - --- reg colors for x86 -#if i386_TARGET_ARCH regDotColor :: RealReg -> SDoc regDotColor reg = let Just str = lookupUFM regColors reg in text str regColors :: UniqFM [Char] -regColors - = listToUFM - $ [ (eax, "#00ff00") - , (ebx, "#0000ff") - , (ecx, "#00ffff") - , (edx, "#0080ff") ] - ++ fpRegColors +regColors = listToUFM (normalRegColors ++ fpRegColors) --- reg colors for x86_64 -#elif x86_64_TARGET_ARCH -regDotColor :: RealReg -> SDoc -regDotColor reg - = let Just str = lookupUFM regColors reg - in text str +-- TODO: We shouldn't be using defaultTargetPlatform here. +-- We should be passing DynFlags in instead, and looking at +-- its targetPlatform. -regColors :: UniqFM [Char] -regColors - = listToUFM - $ [ (rax, "#00ff00"), (eax, "#00ff00") - , (rbx, "#0000ff"), (ebx, "#0000ff") - , (rcx, "#00ffff"), (ecx, "#00ffff") - , (rdx, "#0080ff"), (edx, "#00ffff") - , (r8, "#00ff80") - , (r9, "#008080") - , (r10, "#0040ff") - , (r11, "#00ff40") - , (r12, "#008040") - , (r13, "#004080") - , (r14, "#004040") - , (r15, "#002080") ] - ++ fpRegColors -#else -regDotColor :: Reg -> SDoc -regDotColor = panic "not defined" -#endif +normalRegColors :: [(Reg,String)] +normalRegColors = case platformArch defaultTargetPlatform of + ArchX86 -> [ (eax, "#00ff00") + , (ebx, "#0000ff") + , (ecx, "#00ffff") + , (edx, "#0080ff") ] + ArchX86_64 -> [ (rax, "#00ff00"), (eax, "#00ff00") + , (rbx, "#0000ff"), (ebx, "#0000ff") + , (rcx, "#00ffff"), (ecx, "#00ffff") + , (rdx, "#0080ff"), (edx, "#00ffff") + , (r8, "#00ff80") + , (r9, "#008080") + , (r10, "#0040ff") + , (r11, "#00ff40") + , (r12, "#008040") + , (r13, "#004080") + , (r14, "#004040") + , (r15, "#002080") ] + ArchPPC -> panic "X86 normalRegColors ArchPPC" + ArchPPC_64 -> panic "X86 normalRegColors ArchPPC_64" + ArchSPARC -> panic "X86 normalRegColors ArchSPARC" + ArchUnknown -> panic "X86 normalRegColors ArchUnknown" -#if i386_TARGET_ARCH || x86_64_TARGET_ARCH fpRegColors :: [(Reg,String)] fpRegColors = [ (fake0, "#ff00ff") @@ -85,4 +73,4 @@ fpRegColors = , (fake5, "#5500ff") ] ++ zip (map regSingle [24..39]) (repeat "red") -#endif + diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 101780d..d226cbe 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -277,8 +277,8 @@ gHC_PRIM, gHC_TYPES, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_CSTRING, gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_TYPE, gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE, - gHC_PACK, gHC_CONC, gHC_IO, gHC_IO_Exception, - gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL, + gHC_CONC, gHC_IO, gHC_IO_Exception, + gHC_ST, gHC_ARR, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL, gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, gENERICS, dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_GROUP, mONAD_ZIP, aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS, @@ -307,14 +307,12 @@ dATA_EITHER = mkBaseModule (fsLit "Data.Either") dATA_STRING = mkBaseModule (fsLit "Data.String") dATA_FOLDABLE = mkBaseModule (fsLit "Data.Foldable") dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable") -gHC_PACK = mkBaseModule (fsLit "GHC.Pack") gHC_CONC = mkBaseModule (fsLit "GHC.Conc") gHC_IO = mkBaseModule (fsLit "GHC.IO") gHC_IO_Exception = mkBaseModule (fsLit "GHC.IO.Exception") gHC_ST = mkBaseModule (fsLit "GHC.ST") gHC_ARR = mkBaseModule (fsLit "GHC.Arr") gHC_STABLE = mkBaseModule (fsLit "GHC.Stable") -gHC_ADDR = mkBaseModule (fsLit "GHC.Addr") gHC_PTR = mkBaseModule (fsLit "GHC.Ptr") gHC_ERR = mkBaseModule (fsLit "GHC.Err") gHC_REAL = mkBaseModule (fsLit "GHC.Real") diff --git a/compiler/utils/Platform.hs b/compiler/utils/Platform.hs index 7b2502d..e4f97bd 100644 --- a/compiler/utils/Platform.hs +++ b/compiler/utils/Platform.hs @@ -31,7 +31,8 @@ data Platform -- about what instruction set extensions an architecture might support. -- data Arch - = ArchX86 + = ArchUnknown + | ArchX86 | ArchX86_64 | ArchPPC | ArchPPC_64 @@ -80,7 +81,7 @@ defaultTargetArch = ArchPPC_64 #elif sparc_TARGET_ARCH defaultTargetArch = ArchSPARC #else -#error "Platform.buildArch: undefined" +defaultTargetArch = ArchUnknown #endif diff --git a/compiler/vectorise/Vectorise/Env.hs b/compiler/vectorise/Vectorise/Env.hs index 5014fd6..780a07f 100644 --- a/compiler/vectorise/Vectorise/Env.hs +++ b/compiler/vectorise/Vectorise/Env.hs @@ -1,24 +1,24 @@ module Vectorise.Env ( - Scope(..), - - -- * Local Environments - LocalEnv(..), - emptyLocalEnv, - - -- * Global Environments - GlobalEnv(..), - initGlobalEnv, - extendImportedVarsEnv, - extendScalars, - setFamEnv, - extendFamEnv, - extendTyConsEnv, - extendDataConsEnv, - extendPAFunsEnv, - setPRFunsEnv, - setBoxedTyConsEnv, - updVectInfo + Scope(..), + + -- * Local Environments + LocalEnv(..), + emptyLocalEnv, + + -- * Global Environments + GlobalEnv(..), + initGlobalEnv, + extendImportedVarsEnv, + extendScalars, + setFamEnv, + extendFamEnv, + extendTyConsEnv, + extendDataConsEnv, + extendPAFunsEnv, + setPRFunsEnv, + setBoxedTyConsEnv, + modVectInfo ) where import HscTypes @@ -31,6 +31,7 @@ import DataCon import VarEnv import VarSet import Var +import NameSet import Name import NameEnv import FastString @@ -38,8 +39,8 @@ import FastString -- | Indicates what scope something (a variable) is in. data Scope a b - = Global a - | Local b + = Global a + | Local b -- LocalEnv ------------------------------------------------------------------- @@ -71,61 +72,68 @@ emptyLocalEnv = LocalEnv { -- GlobalEnv ------------------------------------------------------------------ --- | The global environment. --- These are things the exist at top-level. + +-- |The global environment: entities that exist at top-level. +-- data GlobalEnv - = GlobalEnv { - -- | Mapping from global variables to their vectorised versions — aka the /vectorisation - -- map/. - global_vars :: VarEnv Var - - -- | Mapping from global variables that have a vectorisation declaration to the right-hand - -- side of that declaration and its type. This mapping only applies to non-scalar - -- vectorisation declarations. All variables with a scalar vectorisation declaration are - -- mentioned in 'global_scalars'. + = GlobalEnv + { global_vars :: VarEnv Var + -- ^Mapping from global variables to their vectorised versions — aka the /vectorisation + -- map/. + , global_vect_decls :: VarEnv (Type, CoreExpr) + -- ^Mapping from global variables that have a vectorisation declaration to the right-hand + -- side of that declaration and its type. This mapping only applies to non-scalar + -- vectorisation declarations. All variables with a scalar vectorisation declaration are + -- mentioned in 'global_scalars_vars'. + + , global_scalar_vars :: VarSet + -- ^Purely scalar variables. Code which mentions only these variables doesn't have to be + -- lifted. This includes variables from the current module that have a scalar + -- vectorisation declaration and those that the vectoriser determines to be scalar. - -- | Purely scalar variables. Code which mentions only these variables doesn't have to be - -- lifted. This includes variables from the current module that have a scalar - -- vectorisation declaration and those that the vectoriser determines to be scalar. - , global_scalars :: VarSet + , global_scalar_tycons :: NameSet + -- ^Type constructors whose values can only contain scalar data. Scalar code may only + -- operate on such data. - -- | Exported variables which have a vectorised version. - , global_exported_vars :: VarEnv (Var, Var) + , global_exported_vars :: VarEnv (Var, Var) + -- ^Exported variables which have a vectorised version. - -- | Mapping from TyCons to their vectorised versions. - -- TyCons which do not have to be vectorised are mapped to themselves. - , global_tycons :: NameEnv TyCon + , global_tycons :: NameEnv TyCon + -- ^Mapping from TyCons to their vectorised versions. + -- TyCons which do not have to be vectorised are mapped to themselves. - -- | Mapping from DataCons to their vectorised versions. , global_datacons :: NameEnv DataCon + -- ^Mapping from DataCons to their vectorised versions. - -- | Mapping from TyCons to their PA dfuns. , global_pa_funs :: NameEnv Var + -- ^Mapping from TyCons to their PA dfuns. - -- | Mapping from TyCons to their PR dfuns. - , global_pr_funs :: NameEnv Var + , global_pr_funs :: NameEnv Var + -- ^Mapping from TyCons to their PR dfuns. - -- | Mapping from unboxed TyCons to their boxed versions. - , global_boxed_tycons :: NameEnv TyCon + , global_boxed_tycons :: NameEnv TyCon + -- ^Mapping from unboxed TyCons to their boxed versions. - -- | External package inst-env & home-package inst-env for class instances. - , global_inst_env :: (InstEnv, InstEnv) + , global_inst_env :: (InstEnv, InstEnv) + -- ^External package inst-env & home-package inst-env for class instances. - -- | External package inst-env & home-package inst-env for family instances. - , global_fam_inst_env :: FamInstEnvs + , global_fam_inst_env :: FamInstEnvs + -- ^External package inst-env & home-package inst-env for family instances. - -- | Hoisted bindings. - , global_bindings :: [(Var, CoreExpr)] + , global_bindings :: [(Var, CoreExpr)] + -- ^Hoisted bindings. } --- | Create an initial global environment +-- |Create an initial global environment. +-- initGlobalEnv :: VectInfo -> [CoreVect] -> (InstEnv, InstEnv) -> FamInstEnvs -> GlobalEnv initGlobalEnv info vectDecls instEnvs famInstEnvs = GlobalEnv { global_vars = mapVarEnv snd $ vectInfoVar info , global_vect_decls = mkVarEnv vects - , global_scalars = mkVarSet scalars + , global_scalar_vars = vectInfoScalarVars info `extendVarSetList` scalars + , global_scalar_tycons = vectInfoScalarTyCons info , global_exported_vars = emptyVarEnv , global_tycons = mapNameEnv snd $ vectInfoTyCon info , global_datacons = mapNameEnv snd $ vectInfoDataCon info @@ -142,71 +150,80 @@ initGlobalEnv info vectDecls instEnvs famInstEnvs -- Operators on Global Environments ------------------------------------------- --- | Extend the list of global variables in an environment. + +-- |Extend the list of global variables in an environment. +-- extendImportedVarsEnv :: [(Var, Var)] -> GlobalEnv -> GlobalEnv extendImportedVarsEnv ps genv - = genv { global_vars = extendVarEnvList (global_vars genv) ps } + = genv { global_vars = extendVarEnvList (global_vars genv) ps } --- | Extend the set of scalar variables in an environment. +-- |Extend the set of scalar variables in an environment. +-- extendScalars :: [Var] -> GlobalEnv -> GlobalEnv extendScalars vs genv - = genv { global_scalars = extendVarSetList (global_scalars genv) vs } + = genv { global_scalar_vars = extendVarSetList (global_scalar_vars genv) vs } --- | Set the list of type family instances in an environment. +-- |Set the list of type family instances in an environment. +-- setFamEnv :: FamInstEnv -> GlobalEnv -> GlobalEnv setFamEnv l_fam_inst genv = genv { global_fam_inst_env = (g_fam_inst, l_fam_inst) } where (g_fam_inst, _) = global_fam_inst_env genv +-- |Extend the list of type family instances. +-- extendFamEnv :: [FamInst] -> GlobalEnv -> GlobalEnv extendFamEnv new genv = genv { global_fam_inst_env = (g_fam_inst, extendFamInstEnvList l_fam_inst new) } where (g_fam_inst, l_fam_inst) = global_fam_inst_env genv - --- | Extend the list of type constructors in an environment. +-- |Extend the list of type constructors in an environment. +-- extendTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv extendTyConsEnv ps genv = genv { global_tycons = extendNameEnvList (global_tycons genv) ps } - --- | Extend the list of data constructors in an environment. +-- |Extend the list of data constructors in an environment. +-- extendDataConsEnv :: [(Name, DataCon)] -> GlobalEnv -> GlobalEnv extendDataConsEnv ps genv = genv { global_datacons = extendNameEnvList (global_datacons genv) ps } - --- | Extend the list of PA functions in an environment. +-- |Extend the list of PA functions in an environment. +-- extendPAFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv extendPAFunsEnv ps genv = genv { global_pa_funs = extendNameEnvList (global_pa_funs genv) ps } - --- | Set the list of PR functions in an environment. +-- |Set the list of PR functions in an environment. +-- setPRFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv setPRFunsEnv ps genv = genv { global_pr_funs = mkNameEnv ps } - --- | Set the list of boxed type constructor in an environment. +-- |Set the list of boxed type constructor in an environment. +-- setBoxedTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv setBoxedTyConsEnv ps genv = genv { global_boxed_tycons = mkNameEnv ps } - --- | TODO: What is this for? -updVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo -updVectInfo env tyenv info +-- |Compute vectorisation information that goes into 'ModGuts' (and is stored in interface files). +-- The incoming 'vectInfo' is that from the 'HscEnv' and 'EPS'. The outgoing one contains only the +-- definitions for the currently compiled module. +-- +modVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo +modVectInfo env tyenv info = info - { vectInfoVar = global_exported_vars env - , vectInfoTyCon = mk_env typeEnvTyCons global_tycons - , vectInfoDataCon = mk_env typeEnvDataCons global_datacons - , vectInfoPADFun = mk_env typeEnvTyCons global_pa_funs + { vectInfoVar = global_exported_vars env + , vectInfoTyCon = mk_env typeEnvTyCons global_tycons + , vectInfoDataCon = mk_env typeEnvDataCons global_datacons + , vectInfoPADFun = mk_env typeEnvTyCons global_pa_funs + , vectInfoScalarVars = global_scalar_vars env `minusVarSet` vectInfoScalarVars info + , vectInfoScalarTyCons = global_scalar_tycons env `minusNameSet` vectInfoScalarTyCons info } where mk_env from_tyenv from_env - = mkNameEnv [(name, (from,to)) - | from <- from_tyenv tyenv - , let name = getName from - , Just to <- [lookupNameEnv (from_env env) name]] - + = mkNameEnv [(name, (from,to)) + | from <- from_tyenv tyenv + , let name = getName from + , Just to <- [lookupNameEnv (from_env env) name]] diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs index 5fcd2ac..e2933cd 100644 --- a/compiler/vectorise/Vectorise/Monad.hs +++ b/compiler/vectorise/Vectorise/Monad.hs @@ -1,27 +1,26 @@ module Vectorise.Monad ( - module Vectorise.Monad.Base, - module Vectorise.Monad.Naming, - module Vectorise.Monad.Local, - module Vectorise.Monad.Global, - module Vectorise.Monad.InstEnv, - initV, - - -- * Builtins - liftBuiltinDs, - builtin, - builtins, - - -- * Variables - lookupVar, - maybeCantVectoriseVarM, - dumpVar, - addGlobalScalar, - deleteGlobalScalar, + module Vectorise.Monad.Base, + module Vectorise.Monad.Naming, + module Vectorise.Monad.Local, + module Vectorise.Monad.Global, + module Vectorise.Monad.InstEnv, + initV, + + -- * Builtins + liftBuiltinDs, + builtin, + builtins, + + -- * Variables + lookupVar, + maybeCantVectoriseVarM, + dumpVar, + addGlobalScalar, - -- * Primitives - lookupPrimPArray, - lookupPrimMethod + -- * Primitives + lookupPrimPArray, + lookupPrimMethod ) where import Vectorise.Monad.Base @@ -98,7 +97,7 @@ initV hsc_env guts info thing_inside No -> return Nothing } } - new_info genv = updVectInfo genv (mg_types guts) info + new_info genv = modVectInfo genv (mg_types guts) info selectBackendErr = sLit "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq" @@ -120,7 +119,7 @@ builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi)) -- Var ------------------------------------------------------------------------ -- | Lookup the vectorised and\/or lifted versions of this variable. --- If it's in the global environment we get the vectorised version. +-- If it's in the global environment we get the vectorised version. -- If it's in the local environment we get both the vectorised and lifted version. lookupVar :: Var -> VM (Scope Var (Var, Var)) lookupVar v @@ -140,29 +139,24 @@ maybeCantVectoriseVarM v p dumpVar :: Var -> a dumpVar var - | Just _ <- isClassOpId_maybe var - = cantVectorise "ClassOpId not vectorised:" (ppr var) + | Just _ <- isClassOpId_maybe var + = cantVectorise "ClassOpId not vectorised:" (ppr var) - | otherwise - = cantVectorise "Variable not vectorised:" (ppr var) + | otherwise + = cantVectorise "Variable not vectorised:" (ppr var) --- local scalars -------------------------------------------------------------- +-- Global scalars -------------------------------------------------------------- addGlobalScalar :: Var -> VM () addGlobalScalar var = do { traceVt "addGlobalScalar" (ppr var) - ; updGEnv $ \env -> env{global_scalars = extendVarSet (global_scalars env) var} - } - -deleteGlobalScalar :: Var -> VM () -deleteGlobalScalar var - = do { traceVt "deleteGlobalScalar" (ppr var) - ; updGEnv $ \env -> env{global_scalars = delVarSet (global_scalars env) var} - } + ; updGEnv $ \env -> env{global_scalar_vars = extendVarSet (global_scalar_vars env) var} + } -- Primitives ----------------------------------------------------------------- + lookupPrimPArray :: TyCon -> VM (Maybe TyCon) lookupPrimPArray = liftBuiltinDs . primPArray diff --git a/compiler/vectorise/Vectorise/Monad/Global.hs b/compiler/vectorise/Vectorise/Monad/Global.hs index ae68ffb..632845f 100644 --- a/compiler/vectorise/Vectorise/Monad/Global.hs +++ b/compiler/vectorise/Vectorise/Monad/Global.hs @@ -73,19 +73,24 @@ defGlobalVar v v' = updGEnv $ \env -> -- Vectorisation declarations ------------------------------------------------- --- | Check whether a variable has a (non-scalar) vectorisation declaration. + +-- |Check whether a variable has a (non-scalar) vectorisation declaration. +-- lookupVectDecl :: Var -> VM (Maybe (Type, CoreExpr)) lookupVectDecl var = readGEnv $ \env -> lookupVarEnv (global_vect_decls env) var -- Scalars -------------------------------------------------------------------- --- | Get the set of global scalar variables. + +-- |Get the set of global scalar variables. +-- globalScalars :: VM VarSet -globalScalars = readGEnv global_scalars +globalScalars = readGEnv global_scalar_vars --- | Check whether a given variable is in the set of global scalar variables. +-- |Check whether a given variable is in the set of global scalar variables. +-- isGlobalScalar :: Var -> VM Bool -isGlobalScalar var = readGEnv $ \env -> elemVarSet var (global_scalars env) +isGlobalScalar var = readGEnv $ \env -> elemVarSet var (global_scalar_vars env) -- TyCons --------------------------------------------------------------------- diff --git a/configure.ac b/configure.ac index 2de4d8a..b634bbf 100644 --- a/configure.ac +++ b/configure.ac @@ -782,7 +782,7 @@ fi dnl ** check whether this machine has BFD and liberty installed (used for debugging) dnl the order of these tests matters: bfd needs liberty AC_CHECK_LIB(iberty, xmalloc) -AC_CHECK_LIB(bfd, bfd_init) +AC_CHECK_LIB(bfd, bfd_uncompress_section_contents) dnl ################################################################ dnl Check for libraries diff --git a/docs/users_guide/7.0.1-notes.xml b/docs/users_guide/7.0.1-notes.xml index 0e6ffb4..4d3e299 100644 --- a/docs/users_guide/7.0.1-notes.xml +++ b/docs/users_guide/7.0.1-notes.xml @@ -300,7 +300,7 @@ import SpecConstr The RTS now exports a function setKeepCAFs which is important when loading Haskell DLLs dynamically, as - a DLL may refer to CAFs that hae already been GCed. + a DLL may refer to CAFs that have already been GCed. diff --git a/docs/users_guide/bugs.xml b/docs/users_guide/bugs.xml index 803f9a8..9b167cc 100644 --- a/docs/users_guide/bugs.xml +++ b/docs/users_guide/bugs.xml @@ -5,7 +5,7 @@ Haskell 98 vs. Glasgow Haskell: language non-compliance - + GHC vs the Haskell 98 language Haskell 98 language vs GHC @@ -19,11 +19,11 @@ Divergence from Haskell 98 - - + + Lexical syntax - + Certain lexical rules regarding qualified identifiers @@ -36,10 +36,10 @@ - + Context-free syntax - + GHC is a little less strict about the layout rule when used @@ -101,14 +101,14 @@ main = do args <- getArgs . See . - + Module system and interface files - + GHC requires the use of hs-boot files to cut the recursive loops among mutually recursive modules as described in . This more of an infelicity - than a bug: the Haskell Report says + than a bug: the Haskell Report says (Section 5.7) "Depending on the Haskell implementation used, separate compilation of mutually recursive modules may require that imported modules contain @@ -141,7 +141,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. - + @@ -251,7 +251,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. the Int type. The fromIntegerfromInteger - function (and hence + function (and hence also fromIntegralfromIntegral ) is a special case when converting to Int. The value of @@ -265,7 +265,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. Negative literals, such as -3, are - specified by (a careful reading of) the Haskell Report as + specified by (a careful reading of) the Haskell Report as meaning Prelude.negate (Prelude.fromInteger 3). So -2147483648 means negate (fromInteger 2147483648). Since fromInteger takes the lower 32 bits of the representation, @@ -302,12 +302,12 @@ checking for duplicates. The reason for this is efficiency, pure and simple. - + Divergence from the FFI specification - + hs_init() not allowed @@ -321,7 +321,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. - + @@ -348,7 +348,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. - GHC does not allow you to have a data type with a context + GHC does not allow you to have a data type with a context that mentions type variables that are not data type parameters. For example: @@ -369,10 +369,10 @@ checking for duplicates. The reason for this is efficiency, pure and simple. using the standard way to encode recursion via a data type: data U = MkU (U -> Bool) - + russel :: U -> Bool russel u@(MkU p) = not $ p u - + x :: Bool x = russel (MkU russel) @@ -414,7 +414,7 @@ checking for duplicates. The reason for this is efficiency, pure and simple. module (whatever that is). - + On Windows, there's a GNU ld/BFD bug whereby it emits bogus PE object files that have more than 0xffff relocations. When GHCi tries to load a package affected by this diff --git a/docs/users_guide/debugging.xml b/docs/users_guide/debugging.xml index 9c48f7d..fe98537 100644 --- a/docs/users_guide/debugging.xml +++ b/docs/users_guide/debugging.xml @@ -8,10 +8,10 @@ Dumping out compiler intermediate structures - + dumping GHC intermediates intermediate passes, output - + @@ -121,7 +121,7 @@ - dumps all rewrite rules specified in this module; + dumps all rewrite rules specified in this module; see . @@ -312,7 +312,7 @@ - + : @@ -357,7 +357,7 @@ Make the interface loader be *real* chatty about what it is - upto. + up to. @@ -368,7 +368,7 @@ Make the type checker be *real* chatty about what it is - upto. + up to. @@ -379,7 +379,7 @@ Make the vectoriser be *real* chatty about what it is - upto. + up to. @@ -390,7 +390,7 @@ Make the renamer be *real* chatty about what it is - upto. + up to. @@ -425,7 +425,7 @@ - + @@ -516,7 +516,7 @@ - Print single alternative case expressions as though they were strict + Print single alternative case expressions as though they were strict let expressions. This is helpful when your code does a lot of unboxing. @@ -554,7 +554,7 @@ - Suppress everything that can be suppressed, except for unique ids as this often + Suppress everything that can be suppressed, except for unique ids as this often makes the printout ambiguous. If you just want to see the overall structure of the code, then start here. @@ -566,7 +566,7 @@ - Suppress the printing of uniques. This may make + Suppress the printing of uniques. This may make the printout ambiguous (e.g. unclear where an occurrence of 'x' is bound), but it makes the output of two compiler runs have many fewer gratuitous differences, so you can realistically apply diff. Once diff @@ -581,7 +581,7 @@ Suppress extended information about identifiers where they are bound. This includes - strictness information and inliner templates. Using this flag can cut the size + strictness information and inliner templates. Using this flag can cut the size of the core dump in half, due to the lack of inliner templates diff --git a/docs/users_guide/ffi-chap.xml b/docs/users_guide/ffi-chap.xml index 97a2378..2fef135 100644 --- a/docs/users_guide/ffi-chap.xml +++ b/docs/users_guide/ffi-chap.xml @@ -51,7 +51,7 @@ Foreign function interface (FFI) calling arbitrary IO procedures in some part of the program.) The Haskell FFI already specifies that arguments and results of -foreign imports and exports will be automatically unwrapped if they are +foreign imports and exports will be automatically unwrapped if they are newtypes (Section 3.2 of the FFI addendum). GHC extends the FFI by automatically unwrapping any newtypes that wrap the IO monad itself. More precisely, wherever the FFI specification requires an IO type, GHC will @@ -96,7 +96,7 @@ OK: the time, then the program will not respond to the user interrupt. - + The problem is that it is not possible in general to interrupt a foreign call safely. However, GHC does provide @@ -106,11 +106,11 @@ OK: of safe or unsafe: -foreign import ccall interruptible +foreign import ccall interruptible "sleep" :: CUint -> IO CUint - interruptble behaves exactly as + interruptible behaves exactly as safe, except that when a throwTo is directed at a thread in an interruptible foreign call, an OS-specific mechanism will be @@ -174,7 +174,7 @@ foreign import ccall interruptible When GHC compiles a module (say M.hs) - which uses foreign export or + which uses foreign export or foreign import "wrapper", it generates two additional files, M_stub.c and M_stub.h. GHC will automatically compile @@ -223,7 +223,7 @@ extern HsInt foo(HsInt a0); ––make, as GHC will automatically link in the correct bits). - + Using your own <literal>main()</literal> Normally, GHC's runtime system provides a @@ -371,7 +371,7 @@ int main(int argc, char *argv[]) - + Using header files @@ -396,7 +396,7 @@ int main(int argc, char *argv[]) available when compiling an inlined version of a foreign call, so the compiler is free to inline foreign calls in any context. - + The -#include option is now deprecated, and the include-files field in a Cabal package specification is ignored. @@ -481,17 +481,17 @@ int main(int argc, char *argv[]) - + Multi-threading and the FFI - + In order to use the FFI in a multi-threaded setting, you must use the option (see ). - + Foreign imports and multi-threading - + When you call a foreign imported function that is annotated as safe (the default), and the program was linked @@ -500,7 +500,7 @@ int main(int argc, char *argv[]) program was linked without , then the other Haskell threads will be blocked until the call returns. - + This means that if you need to make a foreign call to a function that takes a long time or blocks indefinitely, then you should mark it safe and @@ -540,7 +540,7 @@ int main(int argc, char *argv[]) The relationship between Haskell threads and OS threads - + Normally there is no fixed relationship between Haskell threads and OS threads. This means that when you make a foreign call, that call may take place in an unspecified OS @@ -560,10 +560,10 @@ int main(int argc, char *argv[]) for the Control.Concurrent module. - + Foreign exports and multi-threading - + When the program is linked with , then you may invoke foreign exported functions from @@ -612,7 +612,7 @@ int main(int argc, char *argv[]) isn't necessary to ensure that the threads have exited first. (Unofficially, if you want to use this fast and loose version of hs_exit(), then call - shutdownHaskellAndExit() instead). + shutdownHaskellAndExit() instead). diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index bfc28d8..3e70be9 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -108,7 +108,7 @@ Which phases to run - + @@ -159,7 +159,7 @@ Alternative modes of operation - + @@ -208,7 +208,7 @@ Redirecting output - + @@ -283,9 +283,9 @@ Keeping intermediate files - + - + @@ -331,7 +331,7 @@ Temporary files - + @@ -434,7 +434,7 @@ - + Recompilation checking @@ -466,7 +466,7 @@ Interactive-mode options - + @@ -509,7 +509,7 @@ Enable usage of Show instances in :print dynamic - + Turn on printing of binding results in GHCi @@ -607,7 +607,7 @@ Language options - Language options can be enabled either by a command-line option + Language options can be enabled either by a command-line option , or by a {-# LANGUAGE blah #-} pragma in the file itself. See @@ -636,7 +636,7 @@ - Enable incoherent instances. + Enable incoherent instances. Implies dynamic @@ -662,7 +662,7 @@ - Enable record + Enable record field disambiguation dynamic @@ -780,7 +780,7 @@ - Enable Template Haskell. + Enable Template Haskell. No longer implied by . dynamic @@ -828,7 +828,7 @@ - + Enable explicit universal quantification. Implied by , , @@ -1040,7 +1040,7 @@ Warnings - + @@ -1173,7 +1173,7 @@ - warn when an import declaration does not explicitly + warn when an import declaration does not explicitly list all the names brought into scope dynamic @@ -1314,7 +1314,7 @@ - + Individual optimisations @@ -1494,7 +1494,7 @@ phase n =n - Set to n (default: 3) the maximum number of + Set to n (default: 3) the maximum number of specialisations that will be created for any one function by the SpecConstr transformation static @@ -1584,7 +1584,7 @@ phase n Profiling options - + @@ -1637,7 +1637,7 @@ phase n Program coverage options - + @@ -2156,7 +2156,7 @@ phase n Platform-specific options - + @@ -2189,7 +2189,7 @@ phase n - + External core file options @@ -2605,7 +2605,7 @@ phase n - + Misc compiler options @@ -2646,7 +2646,7 @@ phase n - Turn off the GHCi sandbox. Means computations are run in teh main thread, rather than a forked thread. + Turn off the GHCi sandbox. Means computations are run in the main thread, rather than a forked thread. dynamic - diff --git a/docs/users_guide/ghci.xml b/docs/users_guide/ghci.xml index 7c3fed2..72481eb 100644 --- a/docs/users_guide/ghci.xml +++ b/docs/users_guide/ghci.xml @@ -4,7 +4,7 @@ GHCi interpreterGHCi interactiveGHCi - + GHCi The ‘i’ stands for “Interactive” @@ -33,7 +33,7 @@ Loading package ghc-prim ... linking ... done. Loading package integer-gmp ... linking ... done. Loading package base ... linking ... done. Loading package ffi-1.0 ... linking ... done. -Prelude> +Prelude> There may be a short pause while GHCi loads the prelude and @@ -54,33 +54,33 @@ Prelude> 1+2 3 Prelude> let x = 42 in x / 9 4.666666666666667 -Prelude> +Prelude> GHCi interprets the whole line as an expression to evaluate. - The expression may not span several lines - as soon as you press enter, + The expression may not span several lines - as soon as you press enter, GHCi will attempt to evaluate it. - GHCi also has a multiline mode, + GHCi also has a multiline mode, :set +m, which is terminated by an empty line: Prelude> :set +m Prelude> let x = 42 in x / 9 -Prelude| +Prelude| 4.666666666666667 -Prelude> +Prelude> - + In Haskell, a let expression is followed - by in. However, in GHCi, since the expression - can also be interpreted in the IO monad, - a let binding with no accompanying - in statement can be signalled by an empty line, + by in. However, in GHCi, since the expression + can also be interpreted in the IO monad, + a let binding with no accompanying + in statement can be signalled by an empty line, as in the above example. - Multiline mode is useful when entering monadic + Multiline mode is useful when entering monadic do statements: @@ -94,7 +94,7 @@ Control.Monad.State| 0 Control.Monad.State> - + During a multiline interaction, the user can interrupt and return to the top-level prompt. @@ -174,7 +174,7 @@ Ok, modules loaded: Main. Modules vs. filenames modulesand filenames filenamesof modules - + Question: How does GHC find the filename which contains module M? Answer: it looks for the file M.hs, or @@ -279,7 +279,7 @@ Ok, modules loaded: A, B, C, D. because the source and everything it depends on is unchanged since the last compilation. - At any time you can use the command + At any time you can use the command :show modules to get a list of the modules currently loaded into GHCi: @@ -302,7 +302,7 @@ A ( A.hs, interpreted ) *Main> :reload Compiling D ( D.hs, interpreted ) Ok, modules loaded: A, B, C, D. -*Main> +*Main> Note that module D was compiled, but in this instance @@ -429,7 +429,7 @@ hello Using <literal>do-</literal>notation at the prompt do-notationin GHCi statementsin GHCi - + GHCi actually accepts statements rather than just expressions at the prompt. This means you can bind values and functions to names, and use them in future @@ -454,10 +454,10 @@ Prelude> it as we did above. If is set then - GHCi will print the result of a statement if and only if: + GHCi will print the result of a statement if and only if: - The statement is not a binding, or it is a monadic binding + The statement is not a binding, or it is a monadic binding (p <- e) that binds exactly one variable. @@ -501,9 +501,9 @@ Prelude> add 1 2 3 Prelude> - However, this quickly gets tedious when defining functions + However, this quickly gets tedious when defining functions with multiple clauses, or groups of mutually recursive functions, - because the complete definition has to be given on a single line, + because the complete definition has to be given on a single line, using explicit braces and semicolons instead of layout: Prelude> let { f op n [] = n ; f op n (h:t) = h `op` f op n t } @@ -525,9 +525,9 @@ Prelude> g (*) 1 [1..3] Such multiline commands can be used with any GHCi command, and the lines between :{ and - :} are simply merged into a single line for + :} are simply merged into a single line for interpretation. That implies that each such group must form a single - valid command when merged, and that no layout rule is used. + valid command when merged, and that no layout rule is used. The main purpose of multiline commands is not to replace module loading but to make definitions in .ghci-files (see ) more readable and maintainable. @@ -571,7 +571,7 @@ xs :: [Integer] - What's really in scope at the prompt? + What's really in scope at the prompt? When you type an expression at the prompt, what identifiers and types are in scope? GHCi provides a flexible @@ -637,7 +637,7 @@ Prelude IO> haskell import syntax as well, but this does not support * forms). - :module can also be shortened to + :module can also be shortened to :m. The full syntax of the :module command is: @@ -785,13 +785,13 @@ bar - + The <literal>it</literal> variable it - + Whenever an expression (or a non-binding statement, to be precise) is typed at the prompt, GHCi implicitly binds its value to the variable it. For example: @@ -804,7 +804,7 @@ Prelude> it * 2 What actually happens is that GHCi typechecks the expression, and if it doesn't have an IO type, then it transforms it as follows: an expression - e turns into + e turns into let it = e; print it @@ -875,7 +875,7 @@ it <- e rules (Section 4.3.4 of the Haskell 2010 Report) as follows. The standard rules take each group of constraints (C1 a, C2 a, ..., Cn a) for each type variable a, and defaults the - type variable if + type variable if @@ -973,7 +973,7 @@ def = toEnum 0 The ability to set a breakpoint on a function definition or expression in the program. When the function - is called, or the expression evaluated, GHCi suspends + is called, or the expression evaluated, GHCi suspends execution and returns to the prompt, where you can inspect the values of local variables before continuing with the execution. @@ -999,7 +999,7 @@ def = toEnum 0 - + There is currently no support for obtaining a “stack trace”, but the tracing and history features provide a useful second-best, which will often be enough to establish the @@ -1007,14 +1007,14 @@ def = toEnum 0 automatically when an exception is thrown, even if it is thrown from within compiled code (see ). - + Breakpoints and inspecting variables - + Let's use quicksort as a running example. Here's the code: -qsort [] = [] +qsort [] = [] qsort (a:as) = qsort left ++ [a] ++ qsort right where (left,right) = (filter (<=a) as, filter (>a) as) @@ -1028,7 +1028,7 @@ Prelude> :l qsort.hs [1 of 1] Compiling Main ( qsort.hs, interpreted ) Ok, modules loaded: Main. *Main> - + Now, let's set a breakpoint on the right-hand-side of the second equation of qsort: @@ -1038,12 +1038,12 @@ Ok, modules loaded: Main. Breakpoint 0 activated at qsort.hs:2:15-46 *Main> - + The command :break 2 sets a breakpoint on line 2 of the most recently-loaded module, in this case qsort.hs. Specifically, it picks the leftmost complete subexpression on that line on which to set the - breakpoint, which in this case is the expression + breakpoint, which in this case is the expression (qsort left ++ [a] ++ qsort right). Now, we run the program: @@ -1064,8 +1064,8 @@ right :: [a] location, we can use the :list command: -[qsort.hs:2:15-46] *Main> :list -1 qsort [] = [] +[qsort.hs:2:15-46] *Main> :list +1 qsort [] = [] 2 qsort (a:as) = qsort left ++ [a] ++ qsort right 3 where (left,right) = (filter (<=a) as, filter (>a) as) @@ -1138,7 +1138,7 @@ left = (_t1::[a]) The flag -fprint-evld-with-show instructs :print to reuse available Show instances when possible. This happens - only when the contents of the variable being inspected + only when the contents of the variable being inspected are completely evaluated. @@ -1174,7 +1174,7 @@ _t1 :: [Integer] [qsort.hs:2:15-46] *Main> a 8 - + You might find it useful to use Haskell's seq function to evaluate individual thunks rather than evaluating the whole expression with :force. @@ -1205,7 +1205,7 @@ _result :: [a] a :: a left :: [a] right :: [a] -[qsort.hs:2:15-46] *Main> +[qsort.hs:2:15-46] *Main> The execution continued at the point it previously stopped, and has @@ -1235,13 +1235,13 @@ right :: [a] :break line :break line column :break module line - :break module line column + :break module line column When a breakpoint is set on a particular line, GHCi sets the breakpoint on the leftmost subexpression that begins and ends on that line. If two - complete subexpressions start at the same + complete subexpressions start at the same column, the longest one is picked. If there is no complete subexpression on the line, then the leftmost expression starting on the line is picked, and failing that the rightmost expression that @@ -1255,7 +1255,7 @@ right :: [a] and doesn't match others. The best advice is to avoid tab characters in your source code altogether (see in ). + />). If the module is omitted, then the most recently-loaded module is used. @@ -1289,7 +1289,7 @@ right :: [a] *Main> :delete 0 *Main> :show breaks [1] Main qsort.hs:2:15-46 - + To delete all breakpoints at once, use :delete *. @@ -1301,7 +1301,7 @@ right :: [a] Single-stepping is a great way to visualise the execution of your program, and it is also a useful tool for identifying the source of a - bug. GHCi offers two variants of stepping. Use + bug. GHCi offers two variants of stepping. Use :step to enable all the breakpoints in the program, and execute until the next breakpoint is reached. Use :steplocal to limit the set @@ -1320,7 +1320,7 @@ _result :: IO () expr begins the evaluation of expr in single-stepping mode. If expr is omitted, then it single-steps from - the current breakpoint. :stepover + the current breakpoint. :stepover works similarly. The :list command is particularly useful when @@ -1328,9 +1328,9 @@ _result :: IO () [qsort.hs:5:7-47] *Main> :list -4 +4 5 main = print (qsort [8, 4, 0, 3, 1, 23, 11, 18]) -6 +6 [qsort.hs:5:7-47] *Main> @@ -1343,9 +1343,9 @@ _result :: IO () [qsort.hs:5:7-47] *Main> :step Stopped at qsort.hs:5:14-46 _result :: [Integer] -4 +4 5 main = print (qsort [8, 4, 0, 3, 1, 23, 11, 18]) -6 +6 [qsort.hs:5:14-46] *Main> @@ -1439,13 +1439,13 @@ _result :: [a] *Main> :list qsort -1 qsort [] = [] +1 qsort [] = [] 2 qsort (a:as) = qsort left ++ [a] ++ qsort right 3 where (left,right) = (filter (<=a) as, filter (>a) as) -4 +4 *Main> :b 1 Breakpoint 1 activated at qsort.hs:1:11-12 -*Main> +*Main> and then run a small qsort with @@ -1490,7 +1490,7 @@ Logged breakpoint at qsort.hs:3:24-38 _result :: [a] as :: [a] a :: a -[-1: qsort.hs:3:24-38] *Main> +[-1: qsort.hs:3:24-38] *Main> Note that the local variables at each step in the history have been @@ -1532,10 +1532,10 @@ a :: a we can't set a breakpoint on it directly. For this reason, GHCi provides the flags -fbreak-on-exception which causes the evaluator to stop when an exception is thrown, and - -fbreak-on-error, which works similarly but stops only on - uncaught exceptions. When stopping at an exception, GHCi will act + -fbreak-on-error, which works similarly but stops only on + uncaught exceptions. When stopping at an exception, GHCi will act just as it does when a breakpoint is hit, with the deviation that it - will not show you any source code location. Due to this, these + will not show you any source code location. Due to this, these commands are only really useful in conjunction with :trace, in order to log the steps leading up to the exception. For example: @@ -1575,15 +1575,15 @@ as = 'b' : 'c' : (_t1::[Char]) Example: inspecting functions - It is possible to use the debugger to examine function values. + It is possible to use the debugger to examine function values. When we are at a breakpoint and a function is in scope, the debugger - cannot show - you the source code for it; however, it is possible to get some - information by applying it to some arguments and observing the result. + cannot show + you the source code for it; however, it is possible to get some + information by applying it to some arguments and observing the result. - The process is slightly complicated when the binding is polymorphic. + The process is slightly complicated when the binding is polymorphic. We show the process by means of an example. To keep things simple, we will use the well known map function: @@ -1607,9 +1607,9 @@ x :: a f :: a -> b xs :: [a] - GHCi tells us that, among other bindings, f is in scope. - However, its type is not fully known yet, - and thus it is not possible to apply it to any + GHCi tells us that, among other bindings, f is in scope. + However, its type is not fully known yet, + and thus it is not possible to apply it to any arguments. Nevertheless, observe that the type of its first argument is the same as the type of x, and its result type is shared with _result. @@ -1617,12 +1617,12 @@ xs :: [a] As we demonstrated earlier (), the - debugger has some intelligence built-in to update the type of - f whenever the types of x or + debugger has some intelligence built-in to update the type of + f whenever the types of x or _result are discovered. So what we do in this scenario is - force x a bit, in order to recover both its type - and the argument part of f. + force x a bit, in order to recover both its type + and the argument part of f. *Main> seq x () *Main> :print x @@ -1631,7 +1631,7 @@ x = 1 We can check now that as expected, the type of x - has been reconstructed, and with it the + has been reconstructed, and with it the type of f has been too: *Main> :t x @@ -1641,7 +1641,7 @@ f :: Integer -> b From here, we can apply f to any argument of type Integer and observe - the results. + the results. let b = f 10 *Main> :t b @@ -1667,10 +1667,10 @@ Just 20 *Main> map f [1..5] [Just 1, Just 2, Just 3, Just 4, Just 5] ]]> - In the first application of f, we had to do + In the first application of f, we had to do some more type reconstruction - in order to recover the result type of f. - But after that, we are free to use + in order to recover the result type of f. + But after that, we are free to use f normally. @@ -1691,7 +1691,7 @@ Just 20 CAF at the prompt again. - Implicit parameters (see ) are only available + Implicit parameters (see ) are only available at the scope of a breakpoint if there is an explicit type signature. @@ -1739,7 +1739,7 @@ $ ghci -package readline GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. Loading package readline-1.0 ... linking ... done. -Prelude> +Prelude> The following command works to load new packages into a @@ -1757,7 +1757,7 @@ Prelude> :set -package name Extra libraries librarieswith GHCi - + Extra libraries may be specified on the command line using the normal -llib option. (The term library here refers to @@ -1889,11 +1889,11 @@ $ ghci -lm modules from packages) only the non-* form of :browse is available. If the ! symbol is appended to the - command, data constructors and class methods will be + command, data constructors and class methods will be listed individually, otherwise, they will only be listed - in the context of their data type or class declaration. - The !-form also annotates the listing - with comments giving possible imports for each group of + in the context of their data type or class declaration. + The !-form also annotates the listing + with comments giving possible imports for each group of entries. Prelude> :browse! Data.Maybe @@ -1961,7 +1961,7 @@ maybe :: b -> (a -> b) -> Maybe a -> b - :continue + :continue :continue Continue the current evaluation, when stopped at a @@ -2067,7 +2067,7 @@ Prelude> :. cmds.ghci - :delete * | num ... + :delete * | num ... :delete @@ -2095,7 +2095,7 @@ Prelude> :. cmds.ghci - :etags + :etags See :ctags. @@ -2185,9 +2185,9 @@ Prelude> :. cmds.ghci the location of its definition in the source. For types and classes, GHCi also summarises instances that mention them. To avoid showing irrelevant information, an instance - is shown only if (a) its head mentions name, + is shown only if (a) its head mentions name, and (b) all the other things mentioned in the instance - are in scope (either qualified or otherwise) as a result of + are in scope (either qualified or otherwise) as a result of a :load or :module commands. @@ -2389,7 +2389,7 @@ bar - :script n + :script n filename :script @@ -2581,7 +2581,7 @@ bar - :step [expr] + :step [expr] :step @@ -2709,7 +2709,7 @@ bar top-level expressions to be discarded after each evaluation (they are still retained during a single evaluation). - + This option may help if the evaluated top-level expressions are consuming large amounts of space, or if you need repeatable performance measurements. @@ -2757,7 +2757,7 @@ bar Prelude> :set -fglasgow-exts - + Any GHC command-line option that is designated as dynamic (see the table in ), may be set using @@ -2812,7 +2812,7 @@ Prelude> :set -fno-glasgow-exts defining useful macros. Placing a .ghci file in a directory with a Haskell project is a useful way to set certain project-wide options so you don't have to type them - everytime you start GHCi: eg. if your project uses GHC extensions + every time you start GHCi: eg. if your project uses GHC extensions and CPP, and has source files in three subdirectories A, B and C, you might put the following lines in .ghci: @@ -2836,7 +2836,7 @@ Prelude> :set -fno-glasgow-exts :def source readFile - With this macro defined in your .ghci + With this macro defined in your .ghci file, you can use :source file to read GHCi commands from file. You can find (and contribute!-) other suggestions for .ghci files on this Haskell @@ -2902,7 +2902,7 @@ Prelude> :set -fno-glasgow-exts FAQ and Things To Watch Out For - + The interpreter can't load modules with foreign export @@ -2991,8 +2991,8 @@ Prelude> :set -fno-glasgow-exts because this is normally what you want in an interpreter: output appears as it is generated. - - If you want line-buffered behaviour, as in GHC, you can + + If you want line-buffered behaviour, as in GHC, you can start your program thus: main = do { hSetBuffering stdout LineBuffering; ... } diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index 0f37953..e1795f2 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -44,8 +44,8 @@ documentation describes all the libraries that come with GHC. Language options can be controlled in two ways: - Every language option can switched on by a command-line flag "" - (e.g. ), and switched off by the flag ""; + Every language option can switched on by a command-line flag "" + (e.g. ), and switched off by the flag ""; (e.g. ). Language options recognised by Cabal can also be enabled using the LANGUAGE pragma, @@ -55,11 +55,11 @@ documentation describes all the libraries that come with GHC. The flag - is equivalent to enabling the following extensions: + is equivalent to enabling the following extensions: &what_glasgow_exts_does; - Enabling these options is the only + Enabling these options is the only effect of . - We are trying to move away from this portmanteau flag, + We are trying to move away from this portmanteau flag, and towards enabling features individually. @@ -77,8 +77,8 @@ While you really can use this stuff to write fast code, unboxed version in any case. And if it isn't, we'd like to know about it. -All these primitive data types and operations are exported by the -library GHC.Prim, for which there is +All these primitive data types and operations are exported by the +library GHC.Prim, for which there is detailed online documentation. (This documentation is generated from the file compiler/prelude/primops.txt.pp.) @@ -89,10 +89,10 @@ into scope. Many of them have names ending in "#", and to mention such names you need the extension (). -The primops make extensive use of unboxed types +The primops make extensive use of unboxed types and unboxed tuples, which we briefly summarise here. - + Unboxed types @@ -124,7 +124,7 @@ know and love—usually one instruction. Primitive (unboxed) types cannot be defined in Haskell, and are therefore built into the language and compiler. Primitive types are always unlifted; that is, a value of a primitive type cannot be -bottom. We use the convention (but it is only a convention) +bottom. We use the convention (but it is only a convention) that primitive types, values, and operations have a # suffix (see ). For some primitive types we have special syntax for literals, also @@ -283,7 +283,7 @@ You can have an unboxed tuple in a pattern binding, thus f x = let (# p,q #) = h x in ..body.. If the types of p and q are not unboxed, -the resulting binding is lazy like any other Haskell pattern binding. The +the resulting binding is lazy like any other Haskell pattern binding. The above example desugars like this: f x = let t = case h x o f{ (# p,q #) -> (p,q) @@ -302,7 +302,7 @@ Indeed, the bindings can even be recursive. Syntactic extensions - + Unicode syntax The language @@ -425,17 +425,17 @@ Indeed, the bindings can even be recursive. postfix modifier to identifiers. Thus, "x#" is a valid variable, and "T#" is a valid type constructor or data constructor. - The hash sign does not change sematics at all. We tend to use variable - names ending in "#" for unboxed values or types (e.g. Int#), - but there is no requirement to do so; they are just plain ordinary variables. + The hash sign does not change semantics at all. We tend to use variable + names ending in "#" for unboxed values or types (e.g. Int#), + but there is no requirement to do so; they are just plain ordinary variables. Nor does the extension bring anything into scope. - For example, to bring Int# into scope you must - import GHC.Prim (see ); + For example, to bring Int# into scope you must + import GHC.Prim (see ); the extension then allows you to refer to the Int# that is now in scope. The also enables some new forms of literals (see ): - + 'x'# has type Char# "foo"# has type Addr# 3# has type Int#. In general, @@ -530,7 +530,7 @@ where -The auxiliary functions are +The auxiliary functions are @@ -575,10 +575,10 @@ This is a bit shorter, but hardly better. Of course, we can rewrite any set of pattern-matching, guarded equations as case expressions; that is precisely what the compiler does when compiling equations! The reason that Haskell provides guarded equations is because they allow us to write down -the cases we want to consider, one at a time, independently of each other. +the cases we want to consider, one at a time, independently of each other. This structure is hidden in the case version. Two of the right-hand sides are really the same (fail), and the whole expression -tends to become more and more indented. +tends to become more and more indented. @@ -594,9 +594,9 @@ clunky env var1 var2 -The semantics should be clear enough. The qualifiers are matched in order. +The semantics should be clear enough. The qualifiers are matched in order. For a <- qualifier, which I call a pattern guard, the -right hand side is evaluated and matched against the pattern on the left. +right hand side is evaluated and matched against the pattern on the left. If the match fails then the whole guard fails and the next equation is tried. If it succeeds, then the appropriate binding takes place, and the next qualifier is matched, in the augmented environment. Unlike list @@ -646,7 +646,7 @@ language as follows: type Typ - + data TypView = Unit | Arrow Typ Typ @@ -658,7 +658,7 @@ view :: Type -> TypeView The representation of Typ is held abstract, permitting implementations to use a fancy representation (e.g., hash-consing to manage sharing). -Without view patterns, using this signature a little inconvenient: +Without view patterns, using this signature a little inconvenient: size :: Typ -> Integer size t = case view t of @@ -673,7 +673,7 @@ against t is buried deep inside another pattern. View patterns permit calling the view function inside the pattern and -matching against the result: +matching against the result: size (view -> Unit) = 1 size (view -> Arrow t1 t2) = size t1 + size t2 @@ -716,7 +716,7 @@ clunky env (lookup env -> Just val1) (lookup env -> Just val2) = val1 + val2 -More precisely, the scoping rules are: +More precisely, the scoping rules are: @@ -734,7 +734,7 @@ example :: (String -> Integer) -> String -> Bool example f (f -> 4) = True That is, the scoping is the same as it would be if the curried arguments -were collected into a tuple. +were collected into a tuple. @@ -750,7 +750,7 @@ let {(x -> y) = e1 ; (y -> x) = e2 } in x -(For some amplification on this design choice see +(For some amplification on this design choice see Trac #4061.) @@ -771,8 +771,8 @@ a T2, then the whole view pattern matches a Haskell 98 Report, add the following: -case v of { (e -> p) -> e1 ; _ -> e2 } - = +case v of { (e -> p) -> e1 ; _ -> e2 } + = case (e v) of { p -> e1 ; _ -> e2 } That is, to match a variable v against a pattern @@ -781,7 +781,7 @@ That is, to match a variable v against a pattern ), evaluate ( exp v ) and match the result against -pat. +pat. Efficiency: When the same view function is applied in @@ -839,7 +839,7 @@ it, you can use the flag. The do-notation of Haskell 98 does not allow recursive bindings, -that is, the variables bound in a do-expression are visible only in the textually following +that is, the variables bound in a do-expression are visible only in the textually following code block. Compare this to a let-expression, where bound variables are visible in the entire binding group. It turns out that several applications can benefit from recursive bindings in the do-notation. The flag provides the necessary syntactic support. @@ -857,7 +857,7 @@ As you can guess justOnes will evaluate to Just [-1, The background and motivation for recursive do-notation is described in A recursive do for Haskell, by Levent Erkok, John Launchbury, -Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania. +Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania. The theory behind monadic value recursion is explained further in Erkok's thesis Value Recursion in Monadic Computations. However, note that GHC uses a different syntax than the one described in these documents. @@ -872,38 +872,38 @@ which wraps a mutually-recursive group of monadic statements, producing a single statement. Similar to a let -statement, the variables bound in the rec are +statement, the variables bound in the rec are visible throughout the rec group, and below it. For example, compare -do { a <- getChar do { a <- getChar - ; let { r1 = f a r2 ; rec { r1 <- f a r2 - ; r2 = g r1 } ; r2 <- g r1 } +do { a <- getChar do { a <- getChar + ; let { r1 = f a r2 ; rec { r1 <- f a r2 + ; r2 = g r1 } ; r2 <- g r1 } ; return (r1 ++ r2) } ; return (r1 ++ r2) } -In both cases, r1 and r2 are +In both cases, r1 and r2 are available both throughout the let or rec block, and in the statements that follow it. The difference is that let is non-monadic, -while rec is monadic. (In Haskell let is +while rec is monadic. (In Haskell let is really letrec, of course.) -The static and dynamic semantics of rec can be described as follows: +The static and dynamic semantics of rec can be described as follows: First, -similar to let-bindings, the rec is broken into +similar to let-bindings, the rec is broken into minimal recursive groups, a process known as segmentation. For example: rec { a <- getChar ===> a <- getChar ; b <- f a c rec { b <- f a c ; c <- f b a ; c <- f b a } - ; putChar c } putChar c + ; putChar c } putChar c The details of segmentation are described in Section 3.2 of A recursive do for Haskell. -Segmentation improves polymorphism, reduces the size of the recursive "knot", and, as the paper +Segmentation improves polymorphism, reduces the size of the recursive "knot", and, as the paper describes, also has a semantic effect (unless the monad satisfies the right-shrinking law). @@ -921,13 +921,13 @@ is desugared to the statement where vs is a tuple of the variables bound by ss. -The original rec typechecks exactly -when the above desugared version would do so. For example, this means that +The original rec typechecks exactly +when the above desugared version would do so. For example, this means that the variables vs are all monomorphic in the statements following the rec, because they are bound by a lambda. -The mfix function is defined in the MonadFix +The mfix function is defined in the MonadFix class, in Control.Monad.Fix, thus: class Monad m => MonadFix m where @@ -951,14 +951,14 @@ then that monad must be declared an instance of the MonadFix -The following instances of MonadFix are automatically provided: List, Maybe, IO. -Furthermore, the Control.Monad.ST and Control.Monad.ST.Lazy modules provide the instances of the MonadFix class +The following instances of MonadFix are automatically provided: List, Maybe, IO. +Furthermore, the Control.Monad.ST and Control.Monad.ST.Lazy modules provide the instances of the MonadFix class for Haskell's internal state monad (strict and lazy, respectively). Like let and where bindings, -name shadowing is not allowed within a rec; +name shadowing is not allowed within a rec; that is, all the names bound in a single rec must be distinct (Section 3.3 of the paper). @@ -1007,7 +1007,7 @@ This name is not supported by GHC. example, the following zips together two lists: - [ (x, y) | x <- xs | y <- ys ] + [ (x, y) | x <- xs | y <- ys ] The behavior of parallel list comprehensions follows that of @@ -1020,26 +1020,26 @@ This name is not supported by GHC. Given a parallel comprehension of the form: - [ e | p1 <- e11, p2 <- e12, ... - | q1 <- e21, q2 <- e22, ... - ... - ] + [ e | p1 <- e11, p2 <- e12, ... + | q1 <- e21, q2 <- e22, ... + ... + ] This will be translated to: - [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] - [(q1,q2) | q1 <- e21, q2 <- e22, ...] - ... - ] + [ e | ((p1,p2), (q1,q2), ...) <- zipN [(p1,p2) | p1 <- e11, p2 <- e12, ...] + [(q1,q2) | q1 <- e21, q2 <- e22, ...] + ... + ] where `zipN' is the appropriate zip for the given number of branches. - + @@ -1059,7 +1059,7 @@ This name is not supported by GHC. Comprehensive comprehensions: comprehensions with "order by" and "group by", except that the syntax we use differs slightly from the paper. The extension is enabled with the flag . -Here is an example: +Here is an example: employees = [ ("Simon", "MS", 80) , ("Erik", "MS", 100) @@ -1073,9 +1073,9 @@ output = [ (the dept, sum salary) , then sortWith by (sum salary) , then take 5 ] -In this example, the list output would take on +In this example, the list output would take on the value: - + [("Yale", 60), ("Ed", 85), ("MS", 180)] @@ -1088,7 +1088,7 @@ function that is exported by GHC.Exts.) all introduced by the (existing) keyword then: - + then f @@ -1096,10 +1096,10 @@ then f This statement requires that f have the type forall a. [a] -> [a]. You can see an example of its use in the motivating example, as this form is used to apply take 5. - + - - + + @@ -1107,13 +1107,13 @@ then f by e This form is similar to the previous one, but allows you to create a function - which will be passed as the first argument to f. As a consequence f must have + which will be passed as the first argument to f. As a consequence f must have the type forall a. (a -> t) -> [a] -> [a]. As you can see - from the type, this function lets f "project out" some information + from the type, this function lets f "project out" some information from the elements of the list it is transforming. - An example is shown in the opening example, where sortWith - is supplied with a function that lets it find out the sum salary + An example is shown in the opening example, where sortWith + is supplied with a function that lets it find out the sum salary for any item in the list comprehension it transforms. @@ -1134,7 +1134,7 @@ then group by e using f at every point after this statement, binders occurring before it in the comprehension refer to lists of possible values, not single values. To help understand this, let's look at an example: - + -- This works similarly to groupWith in GHC.Exts, but doesn't sort its input first groupRuns :: Eq b => (a -> b) -> [a] -> [[a]] @@ -1152,8 +1152,8 @@ output = [ (the x, y) [(1, [4, 5, 6]), (2, [4, 5, 6]), (3, [4, 5, 6]), (1, [4, 5, 6]), (2, [4, 5, 6])] - Note that we have used the the function to change the type - of x from a list to its original numeric type. The variable y, in contrast, is left + Note that we have used the the function to change the type + of x from a list to its original numeric type. The variable y, in contrast, is left unchanged from the list form introduced by the grouping. @@ -1166,13 +1166,13 @@ then group by e This form of grouping is essentially the same as the one described above. However, since no function to use for the grouping has been supplied it will fall back on the - groupWith function defined in + groupWith function defined in GHC.Exts. This is the form of the group statement that we made use of in the opening example. - - + + @@ -1182,7 +1182,7 @@ then group using f With this form of the group statement, f is required to simply have the type forall a. [a] -> [[a]], which will be used to group up the comprehension so far directly. An example of this form is as follows: - + output = [ x | y <- [1..5] @@ -1208,10 +1208,10 @@ output = [ x monad comprehensions - Monad comprehesions generalise the list comprehension notation, - including parallel comprehensions - () and - transform comprenensions () + Monad comprehensions generalise the list comprehension notation, + including parallel comprehensions + () and + transform comprehensions () to work for any monad. @@ -1364,11 +1364,11 @@ do (x,y) <- mzip (do x <- [1..10] compatible to built-in, transform and parallel list comprehensions. More formally, the desugaring is as follows. We write D[ e | Q] -to mean the desugaring of the monad comprehension [ e | Q]: +to mean the desugaring of the monad comprehension [ e | Q]: Expressions: e Declarations: d -Lists of qualifiers: Q,R,S +Lists of qualifiers: Q,R,S -- Basic forms D[ e | ] = return e @@ -1384,11 +1384,11 @@ D[ e | Q then f, R ] = f D[ Qv | Q ] >>= \Qv -> D[ e | D[ e | Q then f by b, R ] = f b D[ Qv | Q ] >>= \Qv -> D[ e | R ] -D[ e | Q then group using f, R ] = f D[ Qv | Q ] >>= \ys -> +D[ e | Q then group using f, R ] = f D[ Qv | Q ] >>= \ys -> case (fmap selQv1 ys, ..., fmap selQvn ys) of Qv -> D[ e | R ] -D[ e | Q then group by b using f, R ] = f b D[ Qv | Q ] >>= \ys -> +D[ e | Q then group by b using f, R ] = f b D[ Qv | Q ] >>= \ys -> case (fmap selQv1 ys, ..., fmap selQvn ys) of Qv -> D[ e | R ] @@ -1404,11 +1404,11 @@ guard Control.Monad t1 -> m t2 fmap GHC.Base forall a b. (a->b) -> n a -> n b mgroupWith Control.Monad.Group forall a. (a -> t) -> m1 a -> m2 (n a) mzip Control.Monad.Zip forall a b. m a -> m b -> m (a,b) - -The comprehension should typecheck when its desugaring would typecheck. + +The comprehension should typecheck when its desugaring would typecheck. -Monad comprehensions support rebindable syntax (). +Monad comprehensions support rebindable syntax (). Without rebindable syntax, the operators from the "standard binding" module are used; with rebindable syntax, the operators are looked up in the current lexical scope. @@ -1416,7 +1416,7 @@ For example, parallel comprehensions will be typechecked and desugared using whatever "mzip" is in scope. -The rebindable operators must have the "Expected type" given in the +The rebindable operators must have the "Expected type" given in the table above. These types are surprisingly general. For example, you can use a bind operator with the type @@ -1449,7 +1449,7 @@ the comprehension being over an arbitrary monad. hierarchy. It completely defeats that purpose if the literal "1" means "Prelude.fromInteger 1", which is what the Haskell Report specifies. - So the + So the flag causes the following pieces of built-in syntax to refer to whatever is in scope, not the Prelude @@ -1459,16 +1459,16 @@ the comprehension being over an arbitrary monad. An integer literal 368 means "fromInteger (368::Integer)", rather than "Prelude.fromInteger (368::Integer)". - + Fractional literals are handed in just the same way, - except that the translation is + except that the translation is fromRational (3.68::Rational). - + The equality test in an overloaded numeric pattern uses whatever (==) is in scope. - + The subtraction operation, and the greater-than-or-equal test, in n+k patterns @@ -1510,7 +1510,7 @@ the comprehension being over an arbitrary monad. In all cases (apart from arrow notation), the static semantics should be that of the desugared form, -even if that is a little unexpected. For example, the +even if that is a little unexpected. For example, the static semantics of the literal 368 is exactly that of fromInteger (368::Integer); it's fine for fromInteger to have any of the types: @@ -1521,7 +1521,7 @@ fromInteger :: Num a => a -> Integer fromInteger :: Integer -> Bool -> Bool - + Be warned: this is an experimental facility, with fewer checks than usual. Use -dcore-lint to typecheck the desugared program. If Core Lint is happy @@ -1609,7 +1609,7 @@ module Foo where import M data T = MkT { x :: Int } - + ok1 (MkS { x = n }) = n+1 -- Unambiguous ok2 n = MkT { x = n+1 } -- Unambiguous @@ -1628,7 +1628,7 @@ it is not clear which of the two types is intended. Haskell 98 regards all four as ambiguous, but with the flag, GHC will accept the former two. The rules are precisely the same as those for instance -declarations in Haskell 98, where the method names on the left-hand side +declarations in Haskell 98, where the method names on the left-hand side of the method bindings in an instance declaration refer unambiguously to the method of that class (provided they are in scope at all), even if there are other variables in scope with the same name. @@ -1639,7 +1639,7 @@ records from different modules that use the same field name. Some details: -Field disambiguation can be combined with punning (see ). For exampe: +Field disambiguation can be combined with punning (see ). For example: module Foo where import M @@ -1649,8 +1649,8 @@ module Foo where -With you can use unqualifed -field names even if the correponding selector is only in scope qualified +With you can use unqualified +field names even if the corresponding selector is only in scope qualified For example, assuming the same module M as in our earlier example, this is legal: module Foo where @@ -1658,7 +1658,7 @@ module Foo where ok4 (M.MkS { x = n }) = n+1 -- Unambiguous -Since the constructore MkS is only in scope qualified, you must +Since the constructor MkS is only in scope qualified, you must name it M.MkS, but the field x does not need to be qualified even though M.x is in scope but x is not. (In effect, it is qualified by the constructor.) @@ -1698,7 +1698,7 @@ f (C {a}) = a to mean the same pattern as above. That is, in a record pattern, the pattern a expands into the pattern a = -a for the same name a. +a for the same name a. @@ -1709,7 +1709,7 @@ Record punning can also be used in an expression, writing, for example, let a = 1 in C {a} -instead of +instead of let a = 1 in C {a = a} @@ -1728,7 +1728,7 @@ f (C {a, b = 4}) = a Puns can be used wherever record patterns occur (e.g. in -let bindings or at the top-level). +let bindings or at the top-level). @@ -1811,9 +1811,9 @@ the same as the omitted field names. -The ".." expands to the missing +The ".." expands to the missing in-scope record fields, where "in scope" -includes both unqualified and qualified-only. +includes both unqualified and qualified-only. Any fields that are not in scope are not filled in. For example module M where @@ -1848,7 +1848,7 @@ the semantics of such bindings very precisely. let f = ... infixr 3 `f` -in +in ... and the fixity declaration applies wherever the binding is in scope. @@ -1883,7 +1883,7 @@ necessary to enable them. import "network" Network.Socket - + would import the module Network.Socket from the package network (any version). This may be used to disambiguate an import when the same module is @@ -1907,7 +1907,7 @@ import "network" Network.Socket "stolen" by language extensions. We use notation and nonterminal names from the Haskell 98 lexical syntax - (see the Haskell 98 Report). + (see the Haskell 98 Report). We only list syntax changes here that might affect existing working programs (i.e. "stolen" syntax). Many of these extensions will also enable new context-free syntax, but in all @@ -1929,7 +1929,7 @@ import "network" Network.Socket on. - + The following syntax is stolen: @@ -2021,12 +2021,12 @@ The following syntax is stolen: varid{#}, - char#, - string#, - integer#, - float#, - float##, - (#, #), + char#, + string#, + integer#, + float#, + float##, + (#, #), Stolen by: , @@ -2053,7 +2053,7 @@ a data type with no constructors. For example: data T a -- T :: * -> * -Syntactically, the declaration lacks the "= constrs" part. The +Syntactically, the declaration lacks the "= constrs" part. The type can be parameterised over types of any kind, but if the kind is not * then an explicit kind annotation must be used (see ). @@ -2121,7 +2121,7 @@ to be written infix, very much like expressions. More specifically: type T (+) = Int + Int f :: T Either f = Left 3 - + liftA2 :: Arrow (~>) => (a -> b -> c) -> (e ~> a) -> (e ~> b) -> (e ~> c) liftA2 = ... @@ -2159,7 +2159,7 @@ Type synonyms are like macros at the type level, but Haskell 98 imposes many rul on individual synonym declarations. With the extension, GHC does validity checking on types only after expanding type synonyms. -That means that GHC can be very much more liberal about type synonyms than Haskell 98. +That means that GHC can be very much more liberal about type synonyms than Haskell 98. You can write a forall (including overloading) @@ -2177,7 +2177,7 @@ in a type synonym, thus: -If you also use , +If you also use , you can write an unboxed tuple in a type synonym: type Pr = (# Int, Int #) @@ -2191,7 +2191,7 @@ you can write an unboxed tuple in a type synonym: You can apply a type synonym to a forall type: type Foo a = a -> a -> Bool - + f :: Foo (forall b. b->b) After expanding the synonym, f has the legal (in GHC) type: @@ -2205,7 +2205,7 @@ You can apply a type synonym to a partially applied type synonym: type Generic i o = forall x. i x -> o x type Id x = x - + foo :: Generic Id [] After expanding the synonym, foo has the legal (in GHC) type: @@ -2454,7 +2454,7 @@ To make use of these hidden fields, we need to create some helper functions: inc :: Counter a -> Counter a inc (NewCounter x i d t) = NewCounter - { _this = i x, _inc = i, _display = d, tag = t } + { _this = i x, _inc = i, _display = d, tag = t } display :: Counter a -> IO () display NewCounter{ _this = x, _display = d } = d x @@ -2463,11 +2463,11 @@ display NewCounter{ _this = x, _display = d } = d x Now we can define counters with different underlying implementations: -counterA :: Counter String +counterA :: Counter String counterA = NewCounter { _this = 0, _inc = (1+), _display = print, tag = "A" } -counterB :: Counter String +counterB :: Counter String counterB = NewCounter { _this = "", _inc = ('#':), _display = putStrLn, tag = "B" } @@ -2671,16 +2671,16 @@ giving the type signatures of constructors explicitly. For example: Just :: a -> Maybe a The form is called a "GADT-style declaration" -because Generalised Algebraic Data Types, described in , +because Generalised Algebraic Data Types, described in , can only be declared using this form. -Notice that GADT-style syntax generalises existential types (). +Notice that GADT-style syntax generalises existential types (). For example, these two declarations are equivalent: data Foo = forall a. MkFoo a (a -> Bool) data Foo' where { MKFoo :: a -> (a->Bool) -> Foo' } -Any data type that can be declared in standard Haskell-98 syntax +Any data type that can be declared in standard Haskell-98 syntax can also be declared using GADT-style syntax. The choice is largely stylistic, but GADT-style declarations differ in one important respect: they treat class constraints on the data constructors differently. @@ -2697,14 +2697,14 @@ context is made available by pattern matching. For example: insert a (MkSet as) | a `elem` as = MkSet as | otherwise = MkSet (a:as) -A use of MkSet as a constructor (e.g. in the definition of makeSet) +A use of MkSet as a constructor (e.g. in the definition of makeSet) gives rise to a (Eq a) constraint, as you would expect. The new feature is that pattern-matching on MkSet (as in the definition of insert) makes available an (Eq a) context. In implementation terms, the MkSet constructor has a hidden field that stores the (Eq a) dictionary that is passed to MkSet; so when pattern-matching that dictionary becomes available for the right-hand side of the match. -In the example, the equality dictionary is used to satisfy the equality constraint +In the example, the equality dictionary is used to satisfy the equality constraint generated by the call to elem, so that the type of insert itself has no Eq constraint. @@ -2720,36 +2720,36 @@ For example, one possible application is to reify dictionaries: plus :: NumInst a -> a -> a -> a plus MkNumInst p q = p + q -Here, a value of type NumInst a is equivalent +Here, a value of type NumInst a is equivalent to an explicit (Num a) dictionary. All this applies to constructors declared using the syntax of . -For example, the NumInst data type above could equivalently be declared +For example, the NumInst data type above could equivalently be declared like this: - data NumInst a + data NumInst a = Num a => MkNumInst (NumInst a) -Notice that, unlike the situation when declaring an existential, there is +Notice that, unlike the situation when declaring an existential, there is no forall, because the Num constrains the -data type's universally quantified type variable a. +data type's universally quantified type variable a. A constructor may have both universal and existential type variables: for example, the following two declarations are equivalent: - data T1 a + data T1 a = forall b. (Num a, Eq b) => MkT1 a b data T2 a where MkT2 :: (Num a, Eq b) => a -> b -> T2 a -All this behaviour contrasts with Haskell 98's peculiar treatment of +All this behaviour contrasts with Haskell 98's peculiar treatment of contexts on a data type declaration (Section 4.2.1 of the Haskell 98 Report). In Haskell 98 the definition data Eq a => Set' a = MkSet' [a] -gives MkSet' the same type as MkSet above. But instead of +gives MkSet' the same type as MkSet above. But instead of making available an (Eq a) constraint, pattern-matching on MkSet' requires an (Eq a) constraint! GHC faithfully implements this behaviour, odd though it is. But for GADT-style declarations, @@ -2763,7 +2763,7 @@ type declarations. The result type of each data constructor must begin with the type constructor being defined. -If the result type of all constructors +If the result type of all constructors has the form T a1 ... an, where a1 ... an are distinct type variables, then the data type is ordinary; otherwise is a generalised data type (). @@ -2781,8 +2781,8 @@ In this example we give a single signature for T1 and The type signature of -each constructor is independent, and is implicitly universally quantified as usual. -In particular, the type variable(s) in the "data T a where" header +each constructor is independent, and is implicitly universally quantified as usual. +In particular, the type variable(s) in the "data T a where" header have no scope, and different constructors may have different universally-quantified type variables: data T a where -- The 'a' has no scope @@ -2799,7 +2799,7 @@ different constructors. For example, this is fine: T1 :: Eq b => b -> b -> T b T2 :: (Show c, Ix c) => c -> [c] -> T c -When patten matching, these constraints are made available to discharge constraints +When pattern matching, these constraints are made available to discharge constraints in the body of the match. For example: f :: T a -> String @@ -2813,8 +2813,8 @@ and similarly the Show constraint arising from the use of
  • -Unlike a Haskell-98-style -data type declaration, the type variable(s) in the "data Set a where" header +Unlike a Haskell-98-style +data type declaration, the type variable(s) in the "data Set a where" header have no scope. Indeed, one can write a kind signature instead: data Set :: * -> * where ... @@ -2851,7 +2851,7 @@ declaration. For example, these two declarations are equivalent Just1 :: a -> Maybe1 a } deriving( Eq, Ord ) - data Maybe2 a = Nothing2 | Just2 a + data Maybe2 a = Nothing2 | Just2 a deriving( Eq, Ord ) @@ -2865,10 +2865,10 @@ in the result type: Nil :: Foo Here the type variable a does not appear in the result type -of either constructor. +of either constructor. Although it is universally quantified in the type of the constructor, such -a type variable is often called "existential". -Indeed, the above declaration declares precisely the same type as +a type variable is often called "existential". +Indeed, the above declaration declares precisely the same type as the data Foo in . The type may contain a class context too, of course: @@ -2889,23 +2889,23 @@ You can use record syntax on a GADT-style data type declaration: As usual, for every constructor that has a field f, the type of field f must be the same (modulo alpha conversion). The Child constructor above shows that the signature -may have a context, existentially-quantified variables, and strictness annotations, +may have a context, existentially-quantified variables, and strictness annotations, just as in the non-record case. (NB: the "type" that follows the double-colon is not really a type, because of the record syntax and strictness annotations. A "type" of this form can appear only in a constructor signature.) - -Record updates are allowed with GADT-style declarations, + +Record updates are allowed with GADT-style declarations, only fields that have the following property: the type of the field mentions no existential type variables. - -As in the case of existentials declared using the Haskell-98-like record syntax + +As in the case of existentials declared using the Haskell-98-like record syntax (), record-selector functions are generated only for those fields that have well-typed -selectors. +selectors. Here is the example of that section, in GADT-style syntax: data Counter a where @@ -2925,18 +2925,18 @@ Nevertheless, you can still use all the field names in pattern matching and reco Generalised Algebraic Data Types (GADTs) -Generalised Algebraic Data Types generalise ordinary algebraic data types +Generalised Algebraic Data Types generalise ordinary algebraic data types by allowing constructors to have richer return types. Here is an example: data Term a where Lit :: Int -> Term Int Succ :: Term Int -> Term Int - IsZero :: Term Int -> Term Bool + IsZero :: Term Int -> Term Bool If :: Term Bool -> Term a -> Term a -> Term a Pair :: Term a -> Term b -> Term (a,b) Notice that the return type of the constructors is not always Term a, as is the -case with ordinary data types. This generality allows us to +case with ordinary data types. This generality allows us to write a well-typed eval function for these Terms: @@ -2947,22 +2947,22 @@ for these Terms: eval (If b e1 e2) = if eval b then eval e1 else eval e2 eval (Pair e1 e2) = (eval e1, eval e2) -The key point about GADTs is that pattern matching causes type refinement. +The key point about GADTs is that pattern matching causes type refinement. For example, in the right hand side of the equation eval :: Term a -> a eval (Lit i) = ... the type a is refined to Int. That's the whole point! -A precise specification of the type rules is beyond what this user manual aspires to, +A precise specification of the type rules is beyond what this user manual aspires to, but the design closely follows that described in the paper Simple unification-based type inference for GADTs, (ICFP 2006). -The general principle is this: type refinement is only carried out +The general principle is this: type refinement is only carried out based on user-supplied type annotations. -So if no type signature is supplied for eval, no type refinement happens, +So if no type signature is supplied for eval, no type refinement happens, and lots of obscure error messages will occur. However, the refinement is quite general. For example, if we had: @@ -2982,14 +2982,14 @@ and Ralf Hinze's may use different notation to that implemented in GHC. -The rest of this section outlines the extensions to GHC that support GADTs. The extension is enabled with +The rest of this section outlines the extensions to GHC that support GADTs. The extension is enabled with . The flag also sets . -A GADT can only be declared using GADT-style syntax (); +A GADT can only be declared using GADT-style syntax (); the old Haskell-98 syntax for data declarations always declares an ordinary data type. The result type of each constructor must begin with the type constructor being defined, -but for a GADT the arguments to the type constructor can be arbitrary monotypes. +but for a GADT the arguments to the type constructor can be arbitrary monotypes. For example, in the Term data type above, the type of each constructor must end with Term ty, but the ty need not be a type variable (e.g. the Lit @@ -3015,7 +3015,7 @@ For example: Lit { val :: Int } :: Term Int Succ { num :: Term Int } :: Term Int Pred { num :: Term Int } :: Term Int - IsZero { arg :: Term Int } :: Term Bool + IsZero { arg :: Term Int } :: Term Bool Pair { arg1 :: Term a , arg2 :: Term b } :: Term (a,b) @@ -3024,11 +3024,11 @@ For example: , fls :: Term a } :: Term a -However, for GADTs there is the following additional constraint: +However, for GADTs there is the following additional constraint: every constructor that has a field f must have the same result type (modulo alpha conversion) -Hence, in the above example, we cannot merge the num -and arg fields above into a +Hence, in the above example, we cannot merge the num +and arg fields above into a single name. Although their field types are both Term Int, their selector functions actually have different types: @@ -3039,7 +3039,7 @@ their selector functions actually have different types: -When pattern-matching against data constructors drawn from a GADT, +When pattern-matching against data constructors drawn from a GADT, for example in a case expression, the following rules apply: The type of the scrutinee must be rigid. @@ -3083,12 +3083,12 @@ The natural generated Eq code would result in these instance instance Eq (f a) => Eq (T1 f a) where ... instance Eq (f (f a)) => Eq (T2 f a) where ... -The first of these is obviously fine. The second is still fine, although less obviously. +The first of these is obviously fine. The second is still fine, although less obviously. The third is not Haskell 98, and risks losing termination of instances. GHC takes a conservative position: it accepts the first two, but not the third. The rule is this: -each constraint in the inferred instance context must consist only of type variables, +each constraint in the inferred instance context must consist only of type variables, with no repetitions. @@ -3112,10 +3112,10 @@ The syntax is identical to that of an ordinary instance declaration apart from ( Note the following points: -You must supply an explicit context (in the example the context is (Eq a)), +You must supply an explicit context (in the example the context is (Eq a)), exactly as you would in an ordinary instance declaration. -(In contrast, in a deriving clause -attached to a data type declaration, the context is inferred.) +(In contrast, in a deriving clause +attached to a data type declaration, the context is inferred.) @@ -3127,7 +3127,7 @@ controlled by the same flags; see . Unlike a deriving declaration attached to a data declaration, the instance can be more specific -than the data type (assuming you also use +than the data type (assuming you also use -XFlexibleInstances, ). Consider for example @@ -3142,10 +3142,10 @@ but other types such as (Foo (Int,Bool)) will not be an insta Unlike a deriving -declaration attached to a data declaration, +declaration attached to a data declaration, GHC does not restrict the form of the data type. Instead, GHC simply generates the appropriate boilerplate code for the specified class, and typechecks it. If there is a type error, it is -your problem. (GHC will show you the offending code if it has a type error.) +your problem. (GHC will show you the offending code if it has a type error.) The merit of this is that you can derive instances for GADTs and other exotic data types, providing only that the boilerplate code does indeed typecheck. For example: @@ -3155,8 +3155,8 @@ data types, providing only that the boilerplate code does indeed typecheck. For deriving instance Show (T a) -In this example, you cannot say ... deriving( Show ) on the -data type declaration for T, +In this example, you cannot say ... deriving( Show ) on the +data type declaration for T, because T is a GADT, but you can generate the instance declaration using stand-alone deriving. @@ -3183,10 +3183,10 @@ GHC always treats the last parameter of the instance Deriving clause for extra classes (<literal>Typeable</literal>, <literal>Data</literal>, etc) -Haskell 98 allows the programmer to add "deriving( Eq, Ord )" to a data type -declaration, to generate a standard instance declaration for classes specified in the deriving clause. +Haskell 98 allows the programmer to add "deriving( Eq, Ord )" to a data type +declaration, to generate a standard instance declaration for classes specified in the deriving clause. In Haskell 98, the only classes that may appear in the deriving clause are the standard -classes Eq, Ord, +classes Eq, Ord, Enum, Ix, Bounded, Read, and Show. @@ -3206,7 +3206,7 @@ Scrap More Boilerplate: Reflection, Zips, and Generalised Casts (Section 7.4 of the paper describes the multiple Typeable classes that are used, and only Typeable1 up to Typeable7 are provided in the library.) -In other cases, there is nothing to stop the programmer writing a TypableX +In other cases, there is nothing to stop the programmer writing a TypeableX class, whose kind suits that of the data type constructor, and then writing the data type instance by hand. @@ -3218,22 +3218,22 @@ instances of the class Generic, defined in as described in . - With , you can derive instances of + With , you can derive instances of the class Functor, defined in GHC.Base. - With , you can derive instances of + With , you can derive instances of the class Foldable, defined in Data.Foldable. - With , you can derive instances of + With , you can derive instances of the class Traversable, defined in Data.Traversable. -In each case the appropriate class must be in scope before it +In each case the appropriate class must be in scope before it can be mentioned in the deriving clause. @@ -3250,7 +3250,7 @@ other classes you have to write an explicit instance declaration. For example, if you define - newtype Dollars = Dollars Int + newtype Dollars = Dollars Int and you want to use arithmetic on Dollars, you have to @@ -3271,9 +3271,9 @@ dictionary, only slower! Generalising the deriving clause -GHC now permits such instances to be derived instead, +GHC now permits such instances to be derived instead, using the flag , -so one can write +so one can write newtype Dollars = Dollars Int deriving (Eq,Show,Num) @@ -3295,10 +3295,10 @@ way. For example, suppose we have implemented state and failure monad transformers, such that - instance Monad m => Monad (State s m) + instance Monad m => Monad (State s m) instance Monad m => Monad (Failure m) -In Haskell 98, we can define a parsing monad by +In Haskell 98, we can define a parsing monad by type Parser tok m a = State [tok] (Failure m) a @@ -3311,9 +3311,9 @@ without needing to write an instance of class Monad, via newtype Parser tok m a = Parser (State [tok] (Failure m) a) deriving Monad -In this case the derived instance declaration is of the form +In this case the derived instance declaration is of the form - instance Monad (State [tok] (Failure m)) => Monad (Parser tok m) + instance Monad (State [tok] (Failure m)) => Monad (Parser tok m) Notice that, since Monad is a constructor class, the @@ -3330,10 +3330,10 @@ application'' of the class appears in the deriving clause. For example, given the class - class StateMonad s m | m -> s where ... - instance Monad m => StateMonad s (State s m) where ... + class StateMonad s m | m -> s where ... + instance Monad m => StateMonad s (State s m) where ... -then we can derive an instance of StateMonad for Parsers by +then we can derive an instance of StateMonad for Parsers by newtype Parser tok m a = Parser (State [tok] (Failure m) a) deriving (Monad, StateMonad [tok]) @@ -3363,10 +3363,10 @@ Derived instance declarations are constructed as follows. Consider the declaration (after expansion of any type synonyms) - newtype T v1...vn = T' (t vk+1...vn) deriving (c1...cm) + newtype T v1...vn = T' (t vk+1...vn) deriving (c1...cm) -where +where The ci are partial applications of @@ -3380,15 +3380,15 @@ where The type t is an arbitrary type. - The type variables vk+1...vn do not occur in t, + The type variables vk+1...vn do not occur in t, nor in the ci, and - None of the ci is Read, Show, + None of the ci is Read, Show, Typeable, or Data. These classes should not "look through" the type or its constructor. You can still - derive these classes for a newtype, but it happens in the usual way, not - via this new mechanism. + derive these classes for a newtype, but it happens in the usual way, not + via this new mechanism. Then, for each ci, the derived instance @@ -3396,13 +3396,13 @@ declaration is: instance ci t => ci (T v1...vk) -As an example which does not work, consider +As an example which does not work, consider - newtype NonMonad m s = NonMonad (State s m s) deriving Monad + newtype NonMonad m s = NonMonad (State s m s) deriving Monad -Here we cannot derive the instance +Here we cannot derive the instance - instance Monad (State s m) => Monad (NonMonad m) + instance Monad (State s m) => Monad (NonMonad m) because the type variable s occurs in State s m, @@ -3418,7 +3418,7 @@ important, since we can only derive instances for the last one. If the StateMonad class above were instead defined as - class StateMonad m s | m -> s where ... + class StateMonad m s | m -> s where ... then we would not have been able to derive an instance for the @@ -3427,7 +3427,7 @@ classes usually have one "main" parameter for which deriving new instances is most interesting. Lastly, all of this applies only for classes other than -Read, Show, Typeable, +Read, Show, Typeable, and Data, for which the built-in derivation applies (section 4.3.3. of the Haskell Report). (For the standard classes Eq, Ord, @@ -3460,7 +3460,7 @@ All the extensions are enabled by the flag. Multi-parameter type classes -Multi-parameter type classes are permitted, with flag . +Multi-parameter type classes are permitted, with flag . For example: @@ -3478,11 +3478,11 @@ For example: In Haskell 98 the context of a class declaration (which introduces superclasses) -must be simple; that is, each predicate must consist of a class applied to -type variables. The flag +must be simple; that is, each predicate must consist of a class applied to +type variables. The flag () lifts this restriction, -so that the only restriction on the context in a class declaration is +so that the only restriction on the context in a class declaration is that the class hierarchy must be acyclic. So these class declarations are OK: @@ -3532,7 +3532,7 @@ class type variable, thus: elem :: Eq a => a -> s a -> Bool The type of elem is illegal in Haskell 98, because it -contains the constraint Eq a, constrains only the +contains the constraint Eq a, constrains only the class type variable (in this case a). GHC lifts this restriction (flag ). @@ -3555,7 +3555,7 @@ The type of the enum method is [a], and this is also the type of the default method. You can lift this restriction and give another type to the default method using the flag . For instance, if you have written a -generic implementation of enumeration in a class GEnum +generic implementation of enumeration in a class GEnum with method genum in terms of GHC.Generics, you can specify a default method that uses that generic implementation: @@ -3574,7 +3574,7 @@ and type-checked with the type -We use default signatures to simplify generic programming in GHC +We use default signatures to simplify generic programming in GHC (). @@ -3587,14 +3587,14 @@ We use default signatures to simplify generic programming in GHC Functional dependencies are implemented as described by Mark Jones -in “Type Classes with Functional Dependencies”, Mark P. Jones, -In Proceedings of the 9th European Symposium on Programming, +in “Type Classes with Functional Dependencies”, Mark P. Jones, +In Proceedings of the 9th European Symposium on Programming, ESOP 2000, Berlin, Germany, March 2000, Springer-Verlag LNCS 1782, . -Functional dependencies are introduced by a vertical bar in the syntax of a -class declaration; e.g. +Functional dependencies are introduced by a vertical bar in the syntax of a +class declaration; e.g. class (Monad m) => MonadState s m | m -> s where ... @@ -3605,7 +3605,7 @@ There should be more documentation, but there isn't (yet). Yell if you need it. Rules for functional dependencies -In a class declaration, all of the class type variables must be reachable (in the sense +In a class declaration, all of the class type variables must be reachable (in the sense mentioned in ) from the free variables of each method type. For example: @@ -3658,7 +3658,7 @@ class like this: from the Hugs user manual, reproduced here (with minor changes) by kind permission of Mark Jones. - + Consider the following class, intended as part of a library for collection types: @@ -3673,7 +3673,7 @@ instances of this class for lists or characteristic functions (both of which can be used to represent collections of any equality type), bit sets (which can be used to represent collections of characters), or hash tables (which can be used to represent any collection whose elements have a hash function). Omitting -standard implementation details, this would lead to the following declarations: +standard implementation details, this would lead to the following declarations: instance Eq e => Collects e [e] where ... instance Eq e => Collects e (e -> Bool) where ... @@ -3683,7 +3683,7 @@ standard implementation details, this would lead to the following declarations: All this looks quite promising; we have a class and a range of interesting implementations. Unfortunately, there are some serious problems with the class -declaration. First, the empty function has an ambiguous type: +declaration. First, the empty function has an ambiguous type: empty :: Collects e ce => ce @@ -3697,12 +3697,12 @@ type. We can sidestep this specific problem by removing the empty member from the class declaration. However, although the remaining members, insert and member, do not have ambiguous types, we still run into problems when we try to use -them. For example, consider the following two functions: +them. For example, consider the following two functions: f x y = insert x . insert y g = f True 'a' -for which GHC infers the following types: +for which GHC infers the following types: f :: (Collects a c, Collects b c) => a -> b -> c -> c g :: (Collects Bool c, Collects Char c) => c -> c @@ -3721,7 +3721,7 @@ might even be in a different module. Faced with the problems described above, some Haskell programmers might be -tempted to use something like the following version of the class declaration: +tempted to use something like the following version of the class declaration: class Collects e c where empty :: c e @@ -3732,16 +3732,16 @@ The key difference here is that we abstract over the type constructor c that is used to form the collection type c e, and not over that collection type itself, represented by ce in the original class declaration. This avoids the immediate problems that we mentioned above: empty has type Collects e c => c -e, which is not ambiguous. +e, which is not ambiguous. -The function f from the previous section has a more accurate type: +The function f from the previous section has a more accurate type: f :: (Collects e c) => e -> e -> c e -> c e The function g from the previous section is now rejected with a type error as we would hope because the type of f does not allow the two arguments to have -different types. +different types. This, then, is an example of a multiple parameter class that does actually work quite well in practice, without ambiguity problems. There is, however, a catch. This version of the Collects class is nowhere near @@ -3767,14 +3767,14 @@ underlying ideas are also discussed in a more theoretical and abstract setting in a manuscript [implparam], where they are identified as one point in a general design space for systems of implicit parameterization.). -To start with an abstract example, consider a declaration such as: +To start with an abstract example, consider a declaration such as: class C a b where ... which tells us simply that C can be thought of as a binary relation on types (or type constructors, depending on the kinds of a and b). Extra clauses can be included in the definition of classes to add information about dependencies -between parameters, as in the following examples: +between parameters, as in the following examples: class D a b | a -> b where ... class E a b | a -> b, b -> a where ... @@ -3797,11 +3797,11 @@ annotated with multiple dependencies using commas as separators, as in the definition of E above. Some dependencies that we can write in this notation are redundant, and will be rejected because they don't serve any useful purpose, and may instead indicate an error in the program. Examples of -dependencies like this include a -> a , -a -> a a , +dependencies like this include a -> a , +a -> a a , a -> , etc. There can also be -some redundancy if multiple dependencies are given, as in -a->b, +some redundancy if multiple dependencies are given, as in +a->b, b->c , a->c , and in which some subset implies the remaining dependencies. Examples like this are not treated as errors. Note that dependencies appear only in class @@ -3816,19 +3816,19 @@ compiler, on the other hand, is responsible for ensuring that the set of instances that are in scope at any given point in the program is consistent with any declared dependencies. For example, the following pair of instance declarations cannot appear together in the same scope because they violate the -dependency for D, even though either one on its own would be acceptable: +dependency for D, even though either one on its own would be acceptable: instance D Bool Int where ... instance D Bool Char where ... -Note also that the following declaration is not allowed, even by itself: +Note also that the following declaration is not allowed, even by itself: instance D [a] b where ... The problem here is that this instance would allow one particular choice of [a] to be associated with more than one choice for b, which contradicts the dependency specified in the definition of D. More generally, this means that, -in any instance of the form: +in any instance of the form: instance D t s where ... @@ -3841,7 +3841,7 @@ The benefit of including dependency information is that it allows us to define more general multiple parameter classes, without ambiguity problems, and with the benefit of more accurate types. To illustrate this, we return to the collection class example, and annotate the original definition of Collects -with a simple dependency: +with a simple dependency: class Collects e ce | ce -> e where empty :: ce @@ -3870,18 +3870,18 @@ contains a variable on the left of the => that is not uniquely determined Dependencies also help to produce more accurate types for user defined functions, and hence to provide earlier detection of errors, and less cluttered types for programmers to work with. Recall the previous definition for a -function f: +function f: f x y = insert x y = insert x . insert y -for which we originally obtained a type: +for which we originally obtained a type: f :: (Collects a c, Collects b c) => a -> b -> c -> c Given the dependency information that we have for Collects, however, we can deduce that a and b must be equal because they both appear as the second parameter in a Collects constraint with the same first parameter c. Hence we -can infer a shorter and more accurate type for f: +can infer a shorter and more accurate type for f: f :: (Collects a c) => a -> a -> c -> c @@ -3992,7 +3992,7 @@ The Paterson Conditions: for each assertion in the context tvsleft -> tvsright, of the class, every type variable in -S(tvsright) must appear in +S(tvsright) must appear in S(tvsleft), where S is the substitution mapping each type variable in the class declaration to the corresponding type in the instance declaration. @@ -4000,8 +4000,8 @@ corresponding type in the instance declaration. These restrictions ensure that context reduction terminates: each reduction step makes the problem smaller by at least one -constructor. Both the Paterson Conditions and the Coverage Condition are lifted -if you give the +constructor. Both the Paterson Conditions and the Coverage Condition are lifted +if you give the flag (). You can find lots of background material about the reason for these restrictions in the paper C4 [a] [a] + instance C4 a a => C4 [a] [a] instance Stateful (ST s) (MutVar s) -- Head can consist of type variables only @@ -4031,7 +4031,7 @@ But these are not: -- Context assertion no smaller than head instance C a => C a where ... - -- (C b b) has more more occurrences of b than the head + -- (C b b) has more occurrences of b than the head instance C b b => Foo [b] where ... @@ -4089,7 +4089,7 @@ the head, something that is excluded by the normal rules. For example: class HasConverter a b | a -> b where convert :: a -> b - + data Foo a = MkFoo a instance (HasConverter a b,Show b) => Show (Foo a) where @@ -4123,7 +4123,7 @@ makes instance inference go into a loop, because it requires the constraint Nevertheless, GHC allows you to experiment with more liberal rules. If you use the experimental flag --XUndecidableInstances, +-XUndecidableInstances, both the Paterson Conditions and the Coverage Condition (described in ) are lifted. Termination is ensured by having a fixed-depth recursion stack. If you exceed the stack depth you get a @@ -4142,11 +4142,11 @@ declaration should be used to resolve a type-class constraint. This behaviour can be modified by two flags: -XOverlappingInstances - + and -XIncoherentInstances , as this section discusses. Both these -flags are dynamic flags, and can be set on a per-module basis, using +flags are dynamic flags, and can be set on a per-module basis, using an OPTIONS_GHC pragma if desired (). When GHC tries to resolve, say, the constraint C Int Bool, @@ -4160,14 +4160,14 @@ these declarations: instance context3 => C Int [a] where ... -- (C) instance context4 => C Int [Int] where ... -- (D) -The instances (A) and (B) match the constraint C Int Bool, +The instances (A) and (B) match the constraint C Int Bool, but (C) and (D) do not. When matching, GHC takes no account of the context of the instance declaration (context1 etc). GHC's default behaviour is that exactly one instance must match the -constraint it is trying to resolve. +constraint it is trying to resolve. It is fine for there to be a potential of overlap (by -including both declarations (A) and (B), say); an error is only reported if a +including both declarations (A) and (B), say); an error is only reported if a particular constraint matches more than one. @@ -4187,16 +4187,16 @@ However, GHC is conservative about committing to an overlapping instance. For e Suppose that from the RHS of f we get the constraint C Int [b]. But GHC does not commit to instance (C), because in a particular -call of f, b might be instantiate +call of f, b might be instantiate to Int, in which case instance (D) would be more specific still. -So GHC rejects the program. +So GHC rejects the program. (If you add the flag , -GHC will instead pick (C), without complaining about +GHC will instead pick (C), without complaining about the problem of subsequent instantiations.) Notice that we gave a type signature to f, so GHC had to -check that f has the specified type. +check that f has the specified type. Suppose instead we do not give a type signature, asking GHC to infer it instead. In this case, GHC will refrain from simplifying the constraint C Int [b] (for the same reason @@ -4204,10 +4204,10 @@ as before) but, rather than rejecting the program, it will infer the type f :: C Int [b] => [b] -> [b] -That postpones the question of which instance to pick to the +That postpones the question of which instance to pick to the call site for f by which time more is known about the type b. -You can write this type signature yourself if you use the +You can write this type signature yourself if you use the flag. @@ -4231,7 +4231,7 @@ of the instance declaration, thus: (You need to do this.) -Warning: overlapping instances must be used with care. They +Warning: overlapping instances must be used with care. They can give rise to incoherence (ie different instance choices are made in different parts of the program) even without . Consider: @@ -4265,20 +4265,20 @@ In function showHelp GHC sees no overlapping instances, and so uses the MyShow [a] instance without complaint. In the call to myshow in main, GHC resolves the MyShow [T] constraint using the overlapping -instance declaration in module Main. As a result, +instance declaration in module Main. As a result, the program prints "Used more specific instance" "Used generic instance" -(An alternative possible behaviour, not currently implemented, +(An alternative possible behaviour, not currently implemented, would be to reject module Help on the grounds that a later instance declaration might overlap the local one.) -The willingness to be overlapped or incoherent is a property of +The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled by the -presence or otherwise of the +presence or otherwise of the and flags when that module is being defined. Specifically, during the lookup process: @@ -4297,12 +4297,12 @@ Suppose an instance declaration does not match the constraint being looked up, b does unify with it, so that it might match when the constraint is further instantiated. Usually GHC will regard this as a reason for not committing to some other constraint. But if the instance declaration was compiled with -, GHC will skip the "does-it-unify?" +, GHC will skip the "does-it-unify?" check for that declaration. -These rules make it possible for a library author to design a library that relies on -overlapping instances without the library client having to know. +These rules make it possible for a library author to design a library that relies on +overlapping instances without the library client having to know. The flag implies the flag, but not vice versa. @@ -4350,7 +4350,7 @@ Haskell's defaulting mechanism is extended to cover string literals, when -Each type in a default declaration must be an +Each type in a default declaration must be an instance of Num or of IsString. @@ -4395,23 +4395,23 @@ to work since it gets translated into an equality comparison. Indexed type families are a new GHC extension to - facilitate type-level + facilitate type-level programming. Type families are a generalisation of associated - data types - (“Associated + data types + (“Associated Types with Class”, M. Chakravarty, G. Keller, S. Peyton Jones, and S. Marlow. In Proceedings of “The 32nd Annual ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages (POPL'05)”, pages 1-13, ACM Press, 2005) and associated type synonyms - (“Type + (“Type Associated Type Synonyms”. M. Chakravarty, G. Keller, and - S. Peyton Jones. + S. Peyton Jones. In Proceedings of “The Tenth ACM SIGPLAN International Conference on Functional Programming”, ACM Press, pages 241-253, 2005). Type families - themselves are described in the paper “Type Checking with Open Type Functions”, T. Schrijvers, - S. Peyton-Jones, + S. Peyton-Jones, M. Chakravarty, and M. Sulzmann, in Proceedings of “ICFP 2008: The 13th ACM SIGPLAN International Conference on Functional Programming”, ACM Press, pages 51-62, 2008. Type families @@ -4420,13 +4420,13 @@ to work since it gets translated into an equality comparison. interfaces as well as interfaces with enhanced static information, much like dependent types. They might also be regarded as an alternative to functional dependencies, but provide a more functional style of type-level programming - than the relational style of functional dependencies. + than the relational style of functional dependencies. Indexed type families, or type families for short, are type constructors that represent sets of types. Set members are denoted by supplying the type family constructor with type parameters, which are called type - indices. The + indices. The difference between vanilla parametrised type constructors and family constructors is much like between parametrically polymorphic functions and (ad-hoc polymorphic) methods of type classes. Parametric polymorphic functions @@ -4434,14 +4434,14 @@ to work since it gets translated into an equality comparison. behaviour in dependence on the class type parameters. Similarly, vanilla type constructors imply the same data representation for all type instances, but family constructors can have varying representation types for varying type - indices. + indices. Indexed type families come in two flavours: data - families and type synonym + families and type synonym families. They are the indexed family variants of algebraic data types and type synonyms, respectively. The instances of data families - can be data types and newtypes. + can be data types and newtypes. Type families are enabled by the flag . @@ -4455,7 +4455,7 @@ to work since it gets translated into an equality comparison. Data families appear in two flavours: (1) they can be defined on the - toplevel + toplevel or (2) they can appear inside type classes (in which case they are known as associated types). The former is the more general variant, as it lacks the requirement for the type-indexes to coincide with the class @@ -4465,11 +4465,11 @@ to work since it gets translated into an equality comparison. and then cover the additional constraints placed on associated types. - + Data family declarations - Indexed data families are introduced by a signature, such as + Indexed data families are introduced by a signature, such as data family GMap k :: * -> * @@ -4483,7 +4483,7 @@ data family Array e Just as with [http://www.haskell.org/ghc/docs/latest/html/users_guide/gadt.html GADT declarations] named arguments are entirely optional, so that we can - declare Array alternatively with + declare Array alternatively with data family Array :: * -> * @@ -4494,7 +4494,7 @@ data family Array :: * -> * When a data family is declared as part of a type class, we drop the family special. The GMap - declaration takes the following form + declaration takes the following form class GMapKey k where data GMap k :: * -> * @@ -4505,7 +4505,7 @@ class GMapKey k where the argument names must be class parameters. Each class parameter may only be used at most once per associated type, but some may be omitted and they may be in an order other than in the class head. Hence, the - following contrived example is admissible: + following contrived example is admissible: class C a b c where data T c a :: * @@ -4514,7 +4514,7 @@ class GMapKey k where - + Data instance declarations @@ -4528,7 +4528,7 @@ class GMapKey k where they are fully applied and expand to a type that is itself admissible - exactly as this is required for occurrences of type synonyms in class instance parameters. For example, the Either - instance for GMap is + instance for GMap is data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) @@ -4537,18 +4537,18 @@ data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) Data and newtype instance declarations are only permitted when an - appropriate family declaration is in scope - just as a class instance declaratoin + appropriate family declaration is in scope - just as a class instance declaration requires the class declaration to be visible. Moreover, each instance declaration has to conform to the kind determined by its family declaration. This implies that the number of parameters of an instance declaration matches the arity determined by the kind of the family. - A data family instance declaration can use the full exprssiveness of + A data family instance declaration can use the full expressiveness of ordinary data or newtype declarations: Although, a data family is introduced with - the keyword "data", a data family instance can + the keyword "data", a data family instance can use either data or newtype. For example: data family T a @@ -4576,7 +4576,7 @@ data instance G [a] b where Even if type families are defined as toplevel declarations, functions that perform different computations for different family instances may still need to be defined as methods of type classes. In particular, the - following is not possible: + following is not possible: data family T a data instance T Int = A @@ -4587,7 +4587,7 @@ foo B = 2 -- ...will produce a type error. Instead, you would have to write foo as a class operation, thus: -class C a where +class C a where foo :: T a -> Int instance Foo Int where foo A = 1 @@ -4598,7 +4598,7 @@ instance Foo Char where Types), it might seem as if a definition, such as the above, should be feasible. However, type families are - in contrast to GADTs - are open; i.e., new instances can always be added, - possibly in other + possibly in other modules. Supporting pattern matching across different data instances would require a form of extensible case construct.) @@ -4609,7 +4609,7 @@ instance Foo Char where When an associated data family instance is declared within a type class instance, we drop the instance keyword in the family instance. So, the Either instance - for GMap becomes: + for GMap becomes: instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) @@ -4622,7 +4622,7 @@ instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where which coincides with the only class parameter. Any parameters to the family constructor that do not correspond to class parameters, need to be variables in every instance; here this is the - variable v. + variable v. Instances for an associated family can only appear as part of @@ -4632,7 +4632,7 @@ instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where types can be omitted in class instances. If an associated family instance is omitted, the corresponding instance type is not inhabited; i.e., only diverging expressions, such - as undefined, can assume the type. + as undefined, can assume the type. @@ -4642,13 +4642,13 @@ instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where In the case of multi-parameter type classes, the visibility of class parameters in the right-hand side of associated family instances depends solely on the parameters of the data - family. As an example, consider the simple class declaration + family. As an example, consider the simple class declaration class C a b where data T a Only one of the two class parameters is a parameter to the data - family. Hence, the following instance declaration is invalid: + family. Hence, the following instance declaration is invalid: instance C [c] d where data T [c] = MkT (c, d) -- WRONG!! 'd' is not in scope @@ -4656,7 +4656,7 @@ instance C [c] d where Here, the right-hand side of the data instance mentions the type variable d that does not occur in its left-hand side. We cannot admit such data instances as they would compromise - type safety. + type safety. @@ -4665,7 +4665,7 @@ instance C [c] d where Type class instances of instances of data families can be defined as usual, and in particular data instance declarations can - have deriving clauses. For example, we can write + have deriving clauses. For example, we can write data GMap () v = GMapUnit (Maybe v) deriving Show @@ -4682,7 +4682,7 @@ instance Show v => Show (GMap () v) where ... reasons that we cannot define a toplevel function that performs pattern matching on the data constructors of different instances of a single type family. - It would require a form of extensible case construct. + It would require a form of extensible case construct. @@ -4692,7 +4692,7 @@ instance Show v => Show (GMap () v) where ... The instance declarations of a data family used in a single program may not overlap at all, independent of whether they are associated or not. In contrast to type class instances, this is not only a matter - of consistency, but one of type safety. + of consistency, but one of type safety. @@ -4716,7 +4716,7 @@ instance Show v => Show (GMap () v) where ... an export item, these may be either imported or defined in the current module. The treatment of import and export items that explicitly list data constructors, such as GMap(GMapEither), is - analogous. + analogous. @@ -4731,7 +4731,7 @@ instance Show v => Show (GMap () v) where ... type name needs to be prefixed by the keyword type. So for example, when explicitly listing the components of the GMapKey class, we write GMapKey(type - GMap, empty, lookup, insert). + GMap, empty, lookup, insert). @@ -4739,7 +4739,7 @@ instance Show v => Show (GMap () v) where ... Examples Assuming our running GMapKey class example, let us - look at some export lists and their meaning: + look at some export lists and their meaning: module GMap (GMapKey) where...: Exports @@ -4750,14 +4750,14 @@ instance Show v => Show (GMap () v) where ... Exports the class, the associated type GMap and the member functions empty, lookup, - and insert. None of the data constructors is + and insert. None of the data constructors is exported. - + module GMap (GMapKey(..), GMap(..)) where...: As before, but also exports all the data - constructors GMapInt, - GMapChar, + constructors GMapInt, + GMapChar, GMapUnit, GMapPair, and GMapUnit. @@ -4778,7 +4778,7 @@ instance Show v => Show (GMap () v) where ... write GMapKey(type GMap(..)) — i.e., sub-component specifications cannot be nested. To specify GMap's data constructors, you have to list - it separately. + it separately. @@ -4787,7 +4787,7 @@ instance Show v => Show (GMap () v) where ... Family instances are implicitly exported, just like class instances. However, this applies only to the heads of instances, not to the data - constructors an instance defines. + constructors an instance defines. @@ -4814,13 +4814,13 @@ instance Show v => Show (GMap () v) where ... Type family declarations - Indexed type families are introduced by a signature, such as + Indexed type families are introduced by a signature, such as type family Elem c :: * The special family distinguishes family from standard type declarations. The result kind annotation is optional and, as - usual, defaults to * if omitted. An example is + usual, defaults to * if omitted. An example is type family Elem c @@ -4831,13 +4831,13 @@ type family Elem c and it implies that the kind of a type family is not sufficient to determine a family's arity, and hence in general, also insufficient to determine whether a type family application is well formed. As an - example, consider the following declaration: + example, consider the following declaration: -type family F a b :: * -> * -- F's arity is 2, +type family F a b :: * -> * -- F's arity is 2, -- although its overall kind is * -> * -> * -> * Given this declaration the following are examples of well-formed and - malformed types: + malformed types: F Char [Int] -- OK! Kind: * -> * F Char [Int] Bool -- OK! Kind: * @@ -4851,7 +4851,7 @@ F Bool -- WRONG: unsaturated application When a type family is declared as part of a type class, we drop the family special. The Elem - declaration takes the following form + declaration takes the following form class Collects ce where type Elem ce :: * @@ -4860,7 +4860,7 @@ class Collects ce where The argument names of the type family must be class parameters. Each class parameter may only be used at most once per associated type, but some may be omitted and they may be in an order other than in the - class head. Hence, the following contrived example is admissible: + class head. Hence, the following contrived example is admissible: class C a b c where type T c a :: * @@ -4882,7 +4882,7 @@ class C a b c where type synonyms are allowed as long as they are fully applied and expand to a type that is admissible - these are the exact same requirements as for data instances. For example, the [e] instance - for Elem is + for Elem is type instance Elem [e] = e @@ -4898,7 +4898,7 @@ type instance Elem [e] = e monotype (i.e., it may not include foralls) and after the expansion of all saturated vanilla type synonyms, no synonyms, except family synonyms may remain. Here are some examples of admissible and illegal type - instances: + instances: type family F a :: * type instance F [Int] = Int -- OK! @@ -4919,7 +4919,7 @@ type instance G Int Char Float = Double -- WRONG: must be two type parameters When an associated family instance is declared within a type class instance, we drop the instance keyword in the family instance. So, the [e] instance - for Elem becomes: + for Elem becomes: instance (Eq (Elem [e])) => Collects ([e]) where type Elem [e] = e @@ -4928,7 +4928,7 @@ instance (Eq (Elem [e])) => Collects ([e]) where The most important point about associated family instances is that the type indexes corresponding to class parameters must be identical to the type given in the instance head; here this is [e], - which coincides with the only class parameter. + which coincides with the only class parameter. Instances for an associated family can only appear as part of instances @@ -4937,7 +4937,7 @@ instance (Eq (Elem [e])) => Collects ([e]) where how methods are handled, declarations of associated types can be omitted in class instances. If an associated family instance is omitted, the corresponding instance type is not inhabited; i.e., only diverging - expressions, such as undefined, can assume the type. + expressions, such as undefined, can assume the type. @@ -4952,11 +4952,11 @@ instance (Eq (Elem [e])) => Collects ([e]) where that is the case, the right-hand sides of the instances must also be syntactically equal under the same substitution. This condition is independent of whether the type family is associated or not, and it is - not only a matter of consistency, but one of type safety. + not only a matter of consistency, but one of type safety. Here are two example to illustrate the condition under which overlap - is permitted. + is permitted. type instance F (a, Int) = [a] type instance F (Int, b) = [b] -- overlap permitted @@ -4973,15 +4973,15 @@ type instance G (Char, a) = [a] -- ILLEGAL overlap, as [Char] /= [Int] In order to guarantee that type inference in the presence of type families decidable, we need to place a number of additional restrictions on the formation of type instance declarations (c.f., - Definition 5 (Relaxed Conditions) of “Type Checking with Open Type Functions”). Instance - declarations have the general form + declarations have the general form type instance F t1 .. tn = t where we require that for every type family application (G s1 - .. sm) in t, + .. sm) in t, s1 .. sm do not contain any type family @@ -4990,7 +4990,7 @@ type instance F t1 .. tn = t the total number of symbols (data type constructors and type variables) in s1 .. sm is strictly smaller than - in t1 .. tn, and + in t1 .. tn, and for every type @@ -5004,13 +5004,13 @@ type instance F t1 .. tn = t of type inference in the presence of, so called, ''loopy equalities'', such as a ~ [F a], where a recursive occurrence of a type variable is underneath a family application and data - constructor application - see the above mentioned paper for details. + constructor application - see the above mentioned paper for details. If the option is passed to the compiler, the above restrictions are not enforced and it is on the programmer to ensure termination of the normalisation of type families - during type inference. + during type inference. @@ -5023,7 +5023,7 @@ type instance F t1 .. tn = t and t2 need to be the same. In the presence of type families, whether two types are equal cannot generally be decided locally. Hence, the contexts of function signatures may include - equality constraints, as in the following example: + equality constraints, as in the following example: sumCollects :: (Collects c1, Collects c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 @@ -5032,13 +5032,13 @@ sumCollects :: (Collects c1, Collects c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 types t1 and t2 of an equality constraint may be arbitrary monotypes; i.e., they may not contain any quantifiers, independent of whether higher-rank types are otherwise - enabled. + enabled. Equality constraints can also appear in class and instance contexts. The former enable a simple translation of programs using functional dependencies into programs using family synonyms instead. The general - idea is to rewrite a class declaration of the form + idea is to rewrite a class declaration of the form class C a b | a -> b @@ -5053,18 +5053,18 @@ class (F a ~ b) => C a b where essentially giving a name to the functional dependency. In class instances, we define the type instances of FD families in accordance with the class head. Method signatures are not affected by that - process. + process. NB: Equalities in superclass contexts are not fully implemented in - GHC 6.10. + GHC 6.10. Type families and instance declarations - Type families require us to extend the rules for - the form of instance heads, which are given + Type families require us to extend the rules for + the form of instance heads, which are given in . Specifically: @@ -5119,9 +5119,9 @@ a type variable any more! The context of a type signature The flag lifts the Haskell 98 restriction -that the type-class constraints in a type signature must have the +that the type-class constraints in a type signature must have the form (class type-variable) or -(class (type-variable type-variable ...)). +(class (type-variable type-variable ...)). With these type signatures are perfectly OK @@ -5159,8 +5159,8 @@ in GHC, you can give the foralls if you want. See type, or another reachable type variable. -A value with a type that does not obey +type, or another reachable type variable. +A value with a type that does not obey this reachability restriction cannot be used without introducing ambiguity; that is why the type is rejected. Here, for example, is an illegal type: @@ -5239,8 +5239,8 @@ territory free in case we need it later. Implicit parameters - Implicit parameters are implemented as described in -"Implicit parameters: dynamic scoping with static types", + Implicit parameters are implemented as described in +"Implicit parameters: dynamic scoping with static types", J Lewis, MB Shields, E Meijer, J Launchbury, 27th ACM Symposium on Principles of Programming Languages (POPL'00), Boston, Jan 2000. @@ -5267,7 +5267,7 @@ However, by a simple extension to the type class system of Haskell, we can support dynamic binding. Basically, we express the use of a dynamically bound variable as a constraint on the type. These constraints lead to types of the form (?x::t') => t, which says "this -function uses a dynamically-bound variable ?x +function uses a dynamically-bound variable ?x of type t'". For example, the following expresses the type of a sort function, implicitly parameterized by a comparison function named cmp. @@ -5277,11 +5277,11 @@ implicitly parameterized by a comparison function named cmp. The dynamic binding constraints are just a new form of predicate in the type class system. -An implicit parameter occurs in an expression using the special form ?x, +An implicit parameter occurs in an expression using the special form ?x, where x is -any valid identifier (e.g. ord ?x is a valid expression). +any valid identifier (e.g. ord ?x is a valid expression). Use of this construct also introduces a new -dynamic-binding constraint in the type of the expression. +dynamic-binding constraint in the type of the expression. For example, the following definition shows how we can define an implicitly parameterized sort function in terms of an explicitly parameterized sortBy function: @@ -5314,8 +5314,8 @@ propagate them. An implicit-parameter type constraint differs from other type class constraints in the following way: All uses of a particular implicit parameter must have -the same type. This means that the type of (?x, ?x) -is (?x::a) => (a,a), and not +the same type. This means that the type of (?x, ?x) +is (?x::a) => (a,a), and not (?x::a, ?x::b) => (a, b), as would be the case for type class constraints. @@ -5340,7 +5340,7 @@ Implicit-parameter constraints do not cause ambiguity. For example, consider: g s = show (read s) Here, g has an ambiguous type, and is rejected, but f -is fine. The binding for ?x at f's call site is +is fine. The binding for ?x at f's call site is quite unambiguous, and fixes the type a. @@ -5360,8 +5360,8 @@ For example, we define the min function by binding A group of implicit-parameter bindings may occur anywhere a normal group of Haskell -bindings can occur, except at top level. That is, they can occur in a let -(including in a list comprehension, or do-notation, or pattern guards), +bindings can occur, except at top level. That is, they can occur in a let +(including in a list comprehension, or do-notation, or pattern guards), or a where clause. Note the following points: @@ -5369,10 +5369,10 @@ Note the following points: An implicit-parameter binding group must be a collection of simple bindings to implicit-style variables (no function-style bindings, and no type signatures); these bindings are -neither polymorphic or recursive. +neither polymorphic or recursive. -You may not mix implicit-parameter bindings with ordinary bindings in a +You may not mix implicit-parameter bindings with ordinary bindings in a single let expression; use two nested lets instead. (In the case of where you are stuck, since you can't nest where clauses.) @@ -5485,7 +5485,7 @@ problem that monads seem over-kill for certain sorts of problem, notably: Linear implicit parameters are just like ordinary implicit parameters, except that they are "linear"; that is, they cannot be copied, and must be explicitly "split" instead. Linear implicit parameters are -written '%x' instead of '?x'. +written '%x' instead of '?x'. (The '/' in the '%' suggests the split!) @@ -5494,7 +5494,7 @@ For example: import GHC.Exts( Splittable ) data NameSupply = ... - + splitNS :: NameSupply -> (NameSupply, NameSupply) newName :: NameSupply -> Name @@ -5509,7 +5509,7 @@ For example: env' = extend env x x' ...more equations for f... -Notice that the implicit parameter %ns is consumed +Notice that the implicit parameter %ns is consumed once by the call to newName once by the recursive call to f @@ -5543,14 +5543,14 @@ and GHC will infer g :: (Splittable a, %ns :: a) => b -> (b,a,a) -The Splittable class is built into GHC. It's exported by module +The Splittable class is built into GHC. It's exported by module GHC.Exts. Other points: - '?x' and '%x' -are entirely distinct implicit parameters: you + '?x' and '%x' +are entirely distinct implicit parameters: you can use them together and they won't interfere with each other. @@ -5583,7 +5583,7 @@ usually a harmless thing to do, we get: But now the name supply is consumed in three places (the two calls to newName,and the recursive call to f), so -the result is utterly different. Urk! We don't even have +the result is utterly different. Urk! We don't even have the beta rule. @@ -5632,7 +5632,7 @@ semantics of the program depends on whether or not foo has a type signature. Yikes! You may say that this is a good reason to dislike linear implicit parameters -and you'd be right. That is why they are an experimental feature. +and you'd be right. That is why they are an experimental feature. @@ -5645,7 +5645,7 @@ and you'd be right. That is why they are an experimental feature. Haskell infers the kind of each type variable. Sometimes it is nice to be able -to give the kind explicitly as (machine-checked) documentation, +to give the kind explicitly as (machine-checked) documentation, just as it is nice to give a type signature for a function. On some occasions, it is essential to do so. For example, in his paper "Restricted Data Types in Haskell" (Haskell Workshop 1999) John Hughes had to define the data type: @@ -5710,9 +5710,9 @@ The parentheses are required. -GHC's type system supports arbitrary-rank +GHC's type system supports arbitrary-rank explicit universal quantification in -types. +types. For example, all the following types are legal: f1 :: forall a b. a -> b -> a @@ -5846,11 +5846,11 @@ the constructor to suitable values, just as usual. For example, a1 :: T Int a1 = T1 (\xy->x) 3 - + a2, a3 :: Swizzle a2 = MkSwizzle sort a3 = MkSwizzle reverse - + a4 :: MonadT Maybe a4 = let r x = Just x b m k = case m of @@ -5917,7 +5917,7 @@ provides an explicit polymorphic type for x, or GHC's type inference will assume that x's type has no foralls in it. -What does it mean to "provide" an explicit type for x? You can do that by +What does it mean to "provide" an explicit type for x? You can do that by giving a type signature for x directly, using a pattern type signature (), thus: @@ -5953,10 +5953,10 @@ it needs to know. Implicit quantification -GHC performs implicit quantification as follows. At the top level (only) of +GHC performs implicit quantification as follows. At the top level (only) of user-written types, if and only if there is no explicit forall, GHC finds all the type variables mentioned in the type that are not already -in scope, and universally quantifies them. For example, the following pairs are +in scope, and universally quantifies them. For example, the following pairs are equivalent: f :: a -> a @@ -6001,8 +6001,8 @@ for rank-2 types. Impredicative polymorphism -GHC supports impredicative polymorphism, -enabled with . +GHC supports impredicative polymorphism, +enabled with . This means that you can call a polymorphic function at a polymorphic type, and parameterise data structures over polymorphic types. For example: @@ -6018,7 +6018,7 @@ Notice here that the Maybe type is parameterised by the The technical details of this extension are described in the paper Boxy types: type inference for higher-rank types and impredicativity, -which appeared at ICFP 2006. +which appeared at ICFP 2006. @@ -6040,9 +6040,9 @@ The type signature for f brings the type variable a< because of the explicit forall (). The type variables bound by a forall scope over the entire definition of the accompanying value declaration. -In this example, the type variable a scopes over the whole +In this example, the type variable a scopes over the whole definition of f, including over -the type signature for ys. +the type signature for ys. In Haskell 98 it is not possible to declare a type for ys; a major benefit of scoped type variables is that it becomes possible to do so. @@ -6084,7 +6084,7 @@ A lexically scoped type variable can be bound by: In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (Section -4.1.2 +4.1.2 of the Haskell Report). Lexically scoped type variables affect this implicit quantification rules as follows: any type variable that is in scope is not universally @@ -6127,7 +6127,7 @@ over the definition of "g", so "x::a" means "x::forall a. a" by Haskell's usual implicit quantification rules. - The signature gives a type for a function binding or a bare variable binding, + The signature gives a type for a function binding or a bare variable binding, not a pattern binding. For example: @@ -6137,7 +6137,7 @@ For example: f2 :: forall a. [a] -> [a] f2 = \(x:xs) -> xs ++ [ x :: a ] -- OK - f3 :: forall a. [a] -> [a] + f3 :: forall a. [a] -> [a] Just f3 = Just (\(x:xs) -> xs ++ [ x :: a ]) -- Not OK! The binding for f3 is a pattern binding, and so its type signature @@ -6159,8 +6159,8 @@ type variables, in the annotated expression. For example: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) -Here, the type signature forall s. ST s Bool brings the -type variable s into scope, in the annotated expression +Here, the type signature forall s. ST s Bool brings the +type variable s into scope, in the annotated expression (op >>= \(x :: STRef s Int) -> g x). @@ -6170,7 +6170,7 @@ type variable s into scope, in the annotated expression Pattern type signatures A type signature may occur in any pattern; this is a pattern type -signature. +signature. For example: -- f and g assume that 'a' is already in scope @@ -6197,7 +6197,7 @@ that are already in scope. For example: Here, the pattern signatures for ys and zs are fine, but the one for v is not because b is -not in scope. +not in scope. However, in all patterns other than pattern bindings, a pattern @@ -6220,7 +6220,7 @@ not already in scope; the effect is to bring it into scope, standing for the existentially-bound type variable. -When a pattern type signature binds a type variable in this way, GHC insists that the +When a pattern type signature binds a type variable in this way, GHC insists that the type variable is bound to a rigid, or fully-known, type variable. This means that any user-written type signature always stands for a completely known type. @@ -6230,7 +6230,7 @@ If all this seems a little odd, we think so too. But we must have could not name existentially-bound type variables in subsequent type signatures. -This is (now) the only situation in which a pattern type +This is (now) the only situation in which a pattern type signature is allowed to mention a lexical variable that is not already in scope. For example, both f and g would be @@ -6240,7 +6240,7 @@ illegal if a was not already in scope. - - + Template Haskell Template Haskell allows you to do compile-time meta-programming in -Haskell. +Haskell. The background to the main technical innovations is discussed in " @@ -6414,23 +6414,23 @@ There is a Wiki page about Template Haskell at http://www.haskell.org/haskellwiki/Template_Haskell, and that is the best place to look for further details. -You may also +You may also consult the online -Haskell library reference material +Haskell library reference material (look for module Language.Haskell.TH). -Many changes to the original design are described in +Many changes to the original design are described in Notes on Template Haskell version 2. Not all of these changes are in GHC, however. - The first example from that paper is set out below () -as a worked example to help get you started. + The first example from that paper is set out below () +as a worked example to help get you started. -The documentation here describes the realisation of Template Haskell in GHC. It is not detailed enough to +The documentation here describes the realisation of Template Haskell in GHC. It is not detailed enough to understand Template Haskell; see the Wiki page. @@ -6454,24 +6454,24 @@ Wiki page. of "$" overrides its meaning as an infix operator, just as "M.x" overrides the meaning of "." as an infix operator. If you want the infix operator, put spaces around it. - A splice can occur in place of + A splice can occur in place of an expression; the spliced expression must have type Q Exp an type; the spliced expression must have type Q Typ - a list of top-level declarations; the spliced expression + a list of top-level declarations; the spliced expression must have type Q [Dec] Note that pattern splices are not supported. - Inside a splice you can can only call functions defined in imported modules, + Inside a splice you can only call functions defined in imported modules, not functions defined elsewhere in the same module. A expression quotation is written in Oxford brackets, thus: - [| ... |], or [e| ... |], - where the "..." is an expression; + [| ... |], or [e| ... |], + where the "..." is an expression; the quotation has type Q Exp. [d| ... |], where the "..." is a list of top-level declarations; the quotation has type Q [Dec]. @@ -6496,17 +6496,17 @@ Wiki page. 'f has type Name, and names the function f. Similarly 'C has type Name and names the data constructor C. In general 'thing interprets thing in an expression context. - + ''T has type Name, and names the type constructor T. That is, ''thing interprets thing in a type context. - + These Names can be used to construct Template Haskell expressions, patterns, declarations etc. They may also be given as an argument to the reify function. - You may omit the $(...) in a top-level declaration splice. + You may omit the $(...) in a top-level declaration splice. Simply writing an expression (rather than a declaration) implies a splice. For example, you can write module Foo where @@ -6525,7 +6525,7 @@ h z = z-1 This abbreviation makes top-level declaration slices quieter and less intimidating. - + (Compared to the original paper, there are many differences of detail. The syntax for a declaration splice uses "$" not "splice". @@ -6551,7 +6551,7 @@ Pattern splices and quotations are not implemented.) You can only run a function at compile time if it is imported from another module that is not part of a mutually-recursive group of modules - that includes the module currently being compiled. Furthermore, all of the modules of + that includes the module currently being compiled. Furthermore, all of the modules of the mutually-recursive group must be reachable by non-SOURCE imports from the module where the splice is to be run. @@ -6573,11 +6573,11 @@ Pattern splices and quotations are not implemented.) Template Haskell works in any mode (--make, --interactive, - or file-at-a-time). There used to be a restriction to the former two, but that restriction + or file-at-a-time). There used to be a restriction to the former two, but that restriction has been lifted. - + A Template Haskell Worked Example To help you get over the confidence barrier, try out this skeletal worked example. First cut and paste the two modules below into "Main.hs" and "Printf.hs": @@ -6647,7 +6647,7 @@ Hello Using Template Haskell with Profiling profilingwith Template Haskell - + Template Haskell relies on GHC's built-in bytecode compiler and interpreter to run the splice expressions. The bytecode interpreter runs the compiled expression on top of the same runtime on which GHC @@ -6699,11 +6699,11 @@ A quasi-quote has the form [quoter| string |]. -The quoter must be the (unqualified) name of an imported -quoter; it cannot be an arbitrary expression. +The quoter must be the (unqualified) name of an imported +quoter; it cannot be an arbitrary expression. -The quoter cannot be "e", +The quoter cannot be "e", "t", "d", or "p", since those overlap with Template Haskell quotations. @@ -6712,7 +6712,7 @@ There must be no spaces in the token [quoter|. -The quoted string +The quoted string can be arbitrary, and may contain newlines. @@ -6730,7 +6730,7 @@ A quasiquote may appear in place of -A quoter is a value of type Language.Haskell.TH.Quote.QuasiQuoter, +A quoter is a value of type Language.Haskell.TH.Quote.QuasiQuoter, which is defined thus: data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp, @@ -6923,7 +6923,7 @@ it won't make much sense unless you've read Hughes's paper. | proc apat -> cmd where proc is a new keyword. -The variables of the pattern are bound in the body of the +The variables of the pattern are bound in the body of the proc-expression, which is a new sort of thing called a command. The syntax of commands is as follows: @@ -7326,7 +7326,7 @@ a new form keyword. Although only GHC implements arrow notation directly, there is also a preprocessor -(available from the +(available from the arrows web page) that translates arrow notation into Haskell 98 for use with other Haskell systems. @@ -7371,7 +7371,7 @@ Because the preprocessor targets Haskell (rather than Core), Bang patterns GHC supports an extension of pattern matching called bang -patterns, written !pat. +patterns, written !pat. Bang patterns are under consideration for Haskell Prime. The Haskell @@ -7379,9 +7379,9 @@ prime feature description contains more discussion and examples than the material below. -The key change is the addition of a new rule to the +The key change is the addition of a new rule to the semantics of pattern matching in the Haskell 98 report. -Add new bullet 10, saying: Matching the pattern !pat +Add new bullet 10, saying: Matching the pattern !pat against a value v behaves as follows: if v is bottom, the match diverges @@ -7413,13 +7413,13 @@ Bang patterns can be nested of course: f2 (!x, y) = [x,y] Here, f2 is strict in x but not in -y. +y. A bang only really has an effect if it precedes a variable or wild-card pattern: f3 !(x,y) = [x,y] f4 (x,y) = [x,y] -Here, f3 and f4 are identical; +Here, f3 and f4 are identical; putting a bang before a pattern that forces evaluation anyway does nothing. @@ -7466,7 +7466,7 @@ g5 x = let y = f x in body g6 x = case f x of { y -> body } g7 x = case f x of { !y -> body } -The functions g5 and g6 mean exactly the same thing. +The functions g5 and g6 mean exactly the same thing. But g7 evaluates (f x), binds y to the result, and then evaluates body. @@ -7496,7 +7496,7 @@ prefix notation: The semantics of Haskell pattern matching is described in -Section 3.17.2 of the Haskell Report. To this description add +Section 3.17.2 of the Haskell Report. To this description add one extra item 10, saying: Matching the pattern !pat against a value v behaves as follows: @@ -7512,13 +7512,13 @@ case v of { !pat -> e; _ -> e' } = v `seq` case v of { pat -> e; _ -> e' } -That leaves let expressions, whose translation is given in +That leaves let expressions, whose translation is given in Section 3.12 of the Haskell Report. -In the translation box, first apply -the following transformation: for each pattern pi that is of -form !qi = ei, transform it to (xi,!qi) = ((),ei), and and replace e0 +In the translation box, first apply +the following transformation: for each pattern pi that is of +form !qi = ei, transform it to (xi,!qi) = ((),ei), and replace e0 by (xi `seq` e0). Then, when none of the left-hand-side patterns have a bang at the top, apply the rules in the existing box. @@ -7646,7 +7646,7 @@ Assertion failures can be caught, see the documentation for the Pragmas all take the form -{-# word ... #-} +{-# word ... #-} where word indicates the type of pragma, and is followed optionally by information specific to that @@ -7656,7 +7656,7 @@ Assertion failures can be caught, see the documentation for the in the following sections; any pragma encountered with an unrecognised word is ignored. The layout rule applies in pragmas, so the closing #-} - should start in a column to the right of the opening {-#. + should start in a column to the right of the opening {-#. Certain pragmas are file-header pragmas: @@ -7666,7 +7666,7 @@ Assertion failures can be caught, see the documentation for the There can be as many file-header pragmas as you please, and they can be - preceded or followed by comments. + preceded or followed by comments. File-header pragmas are read once only, before @@ -7686,7 +7686,7 @@ Assertion failures can be caught, see the documentation for the LANGUAGEpragma pragmaLANGUAGE - The LANGUAGE pragma allows language extensions to be enabled + The LANGUAGE pragma allows language extensions to be enabled in a portable way. It is the intention that all Haskell compilers support the LANGUAGE pragma with the same syntax, although not @@ -7795,7 +7795,7 @@ Assertion failures can be caught, see the documentation for the (a) uses within the defining module, and (b) uses in an export list. The latter reduces spurious complaints within a library - in which one module gathers together and re-exports + in which one module gathers together and re-exports the exports of several others. You can suppress the warnings with the flag @@ -7832,7 +7832,7 @@ key_function :: Int -> String -> (Bool, Double) The major effect of an INLINE pragma is to declare a function's “cost” to be very low. The normal unfolding machinery will then be very keen to - inline it. However, an INLINE pragma for a + inline it. However, an INLINE pragma for a function "f" has a number of other effects: @@ -7846,13 +7846,13 @@ there really isn't any point in inlining key_function to get map (\x -> body) xs In general, GHC only inlines the function if there is some reason (no matter -how slight) to supose that it is useful to do so. +how slight) to suppose that it is useful to do so. -Moreover, GHC will only inline the function if it is fully applied, +Moreover, GHC will only inline the function if it is fully applied, where "fully applied" -means applied to as many arguments as appear (syntactically) +means applied to as many arguments as appear (syntactically) on the LHS of the function definition. For example: @@ -7864,7 +7864,7 @@ comp2 :: (b -> c) -> (a -> b) -> a -> c {-# INLINE comp2 #-} comp2 f g x = f (g x) -The two functions comp1 and comp2 have the +The two functions comp1 and comp2 have the same semantics, but comp1 will be inlined when applied to two arguments, while comp2 requires three. This might make a big difference if you say @@ -7874,14 +7874,14 @@ map (not `comp1` not) xs which will optimise better than the corresponding use of `comp2`. - + It is useful for GHC to optimise the definition of an -INLINE function f just like any other non-INLINE function, +INLINE function f just like any other non-INLINE function, in case the non-inlined version of f is -ultimately called. But we don't want to inline +ultimately called. But we don't want to inline the optimised version of f; -a major reason for INLINE pragmas is to expose functions +a major reason for INLINE pragmas is to expose functions in f's RHS that have rewrite rules, and it's no good if those functions have been optimised away. @@ -7890,7 +7890,7 @@ away. So GHC guarantees to inline precisely the code that you wrote, no more and no less. It does this by capturing a copy of the definition of the function to use for inlining (we call this the "inline-RHS"), which it leaves untouched, -while optimising the ordinarly RHS as usual. For externally-visible functions +while optimising the ordinarily RHS as usual. For externally-visible functions the inline-RHS (not the optimised RHS) is recorded in the interface file. @@ -7925,13 +7925,13 @@ itself, so an INLINE pragma is always ignored. {-# INLINE returnUs #-} - See also the NOINLINE () - and INLINABLE () + See also the NOINLINE () + and INLINABLE () pragmas. Note: the HBC compiler doesn't like INLINE pragmas, so if you want your code to be HBC-compatible you'll have to surround - the pragma with C pre-processor directives + the pragma with C pre-processor directives #ifdef __GLASGOW_HASKELL__...#endif. @@ -7989,7 +7989,7 @@ The principal reason do to so to allow later use of SPECIALISE NOINLINE pragma - + NOINLINE NOTINLINE @@ -8008,7 +8008,7 @@ The principal reason do to so to allow later use of SPECIALISE CONLIKE modifier CONLIKE - An INLINE or NOINLINE pragma may have a CONLIKE modifier, + An INLINE or NOINLINE pragma may have a CONLIKE modifier, which affects matching in RULEs (only). See . @@ -8082,27 +8082,27 @@ happen. ANN pragmas - + GHC offers the ability to annotate various code constructs with additional data by using three pragmas. This data can then be inspected at a later date by using GHC-as-a-library. - + Annotating values - + ANN - + Any expression that has both Typeable and Data instances may be attached to a top-level value binding using an ANN pragma. In particular, this means you can use ANN to annotate data constructors (e.g. Just) as well as normal values (e.g. take). By way of example, to annotate the function foo with the annotation Just "Hello" you would do this: - + {-# ANN foo (Just "Hello") #-} foo = ... - + A number of restrictions apply to use of annotations: @@ -8111,46 +8111,46 @@ foo = ... The expression you are annotating with must have a type with Typeable and Data instances The Template Haskell staging restrictions apply to the expression being annotated with, so for example you cannot run a function from the module being compiled. - - To be precise, the annotation {-# ANN x e #-} is well staged if and only if $(e) would be + + To be precise, the annotation {-# ANN x e #-} is well staged if and only if $(e) would be (disregarding the usual type restrictions of the splice syntax, and the usual restriction on splicing inside a splice - $([|1|]) is fine as an annotation, albeit redundant). - + If you feel strongly that any of these restrictions are too onerous, please give the GHC team a shout. - + However, apart from these restrictions, many things are allowed, including expressions which are not fully evaluated! Annotation expressions will be evaluated by the compiler just like Template Haskell splices are. So, this annotation is fine: - + {-# ANN f SillyAnnotation { foo = (id 10) + $([| 20 |]), bar = 'f } #-} f = ... - + Annotating types - + ANN type ANN - + You can annotate types with the ANN pragma by using the type keyword. For example: - + {-# ANN type Foo (Just "A `Maybe String' annotation") #-} data Foo = ... - + Annotating modules - + ANN module ANN - + You can annotate modules with the ANN pragma by using the module keyword. For example: - + {-# ANN module (Just "A `Maybe String' annotation") #-} @@ -8238,7 +8238,7 @@ data Foo = ... h :: Eq a => a -> a -> a {-# SPECIALISE h :: (Eq a) => [a] -> [a] -> [a] #-} -The last of these examples will generate a +The last of these examples will generate a RULE with a somewhat-complex left-hand side (try it yourself), so it might not fire very well. If you use this kind of specialisation, let us know how well it works. @@ -8247,7 +8247,7 @@ well. If you use this kind of specialisation, let us know how well it works. SPECIALIZE INLINE A SPECIALIZE pragma can optionally be followed with a -INLINE or NOINLINE pragma, optionally +INLINE or NOINLINE pragma, optionally followed by a phase, as described in . The INLINE pragma affects the specialised version of the function (only), and applies even if the function is recursive. The motivating @@ -8282,7 +8282,7 @@ on an ordinarily-recursive function. Generally, you can only give a SPECIALIZE pragma for a function defined in the same module. However if a function f is given an INLINABLE -pragma at its definition site, then it can subequently be specialised by +pragma at its definition site, then it can subsequently be specialised by importing modules (see ). For example @@ -8333,7 +8333,7 @@ pragma can be useful. -Obselete SPECIALIZE syntax +Obsolete SPECIALIZE syntax Note: In earlier versions of GHC, it was possible to provide your own specialised function for a given type: @@ -8358,7 +8358,7 @@ pragma can be useful. Same idea, except for instance declarations. For example: -instance (Eq a) => Eq (Foo a) where { +instance (Eq a) => Eq (Foo a) where { {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-} ... usual stuff ... } @@ -8377,7 +8377,7 @@ of the pragma. UNPACK pragma UNPACK - + The UNPACK indicates to the compiler that it should unpack the contents of a constructor field into the constructor itself, removing a level of indirection. For @@ -8457,7 +8457,7 @@ data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int The programmer can specify rewrite rules as part of the source program -(in a pragma). +(in a pragma). Here is an example: @@ -8590,7 +8590,7 @@ declarations. Inside a RULE "forall" is treated as a keyword, regardless of any other flag settings. Furthermore, inside a RULE, the language extension - is automatically enabled; see + is automatically enabled; see . @@ -8598,9 +8598,9 @@ any other flag settings. Furthermore, inside a RULE, the language extension Like other pragmas, RULE pragmas are always checked for scope errors, and -are typechecked. Typechecking means that the LHS and RHS of a rule are typechecked, +are typechecked. Typechecking means that the LHS and RHS of a rule are typechecked, and must have the same type. However, rules are only enabled -if the flag is +if the flag is on (see ). @@ -8623,8 +8623,8 @@ Rules are enabled (that is, used during optimisation) by the flag. This flag is implied by , and may be switched off (as usual) by . -(NB: enabling without -may not do what you expect, though, because without GHC +(NB: enabling without +may not do what you expect, though, because without GHC ignores all optimisation information in interface files; see , .) Note that is an optimisation flag, and @@ -8733,12 +8733,12 @@ to give g y = y Now g is inlined into h, but f's RULE has -no chance to fire. +no chance to fire. If instead GHC had first inlined g into h then there -would have been a better chance that f's RULE might fire. +would have been a better chance that f's RULE might fire. -The way to get predictable behaviour is to use a NOINLINE +The way to get predictable behaviour is to use a NOINLINE pragma, or an INLINE[phase] pragma, on f, to ensure that it is not inlined until its RULEs have had a chance to fire. @@ -8761,12 +8761,12 @@ when this is a good idea, so we provide the CONLIKE pragma to declare it, thus: {-# INLINE[1] CONLIKE f #-} f x = blah -CONLIKE is a modifier to an INLINE or NOINLINE pragam. It specifies that an application +CONLIKE is a modifier to an INLINE or NOINLINE pragma. It specifies that an application of f to one argument (in general, the number of arguments to the left of the '=' sign) should be considered cheap enough to duplicate, if such a duplication would make rule fire. (The name "CONLIKE" is short for "constructor-like", because constructors certainly have such a property.) -The CONLIKE pragam is a modifier to INLINE/NOINLINE because it really only makes sense to match +The CONLIKE pragma is a modifier to INLINE/NOINLINE because it really only makes sense to match f on the LHS of a rule if you are sure that f is not going to be inlined before the rule has a chance to fire. @@ -9041,7 +9041,7 @@ comparison. Use to see the rules that are defined in this module. This includes rules generated by the specialisation pass, but excludes -rules imported from other modules. +rules imported from other modules. @@ -9174,7 +9174,7 @@ allows control over inlining on a per-call-site basis. restrains the strictness analyser. -unsafeCoerce# +unsafeCoerce# allows you to fool the type checker. @@ -9212,7 +9212,7 @@ or the original paper: -José Pedro Magalhães, Atze Dijkstra, Johan Jeuring, and Andres Löh. +Jos� Pedro Magalh�es, Atze Dijkstra, Johan Jeuring, and Andres L�h. A generic deriving mechanism for Haskell. Proceedings of the third ACM Haskell symposium on Haskell @@ -9240,17 +9240,17 @@ that can be used to represent most Haskell datatypes: -- | Unit: used for constructors without arguments data U1 p = U1 - + -- | Constants, additional parameters and recursion of kind * newtype K1 i c p = K1 { unK1 :: c } - + -- | Meta-information (constructor names, etc.) newtype M1 i c f p = M1 { unM1 :: f p } - + -- | Sums: encode choice between constructors infixr 5 :+: data (:+:) f g p = L1 (f p) | R1 (g p) - + -- | Products: encode multiple arguments to constructors infixr 6 :*: data (:*:) f g p = f p :*: g p @@ -9262,7 +9262,7 @@ For example, a user-defined datatype of trees data UserTree a = Node a instance Generic (UserTree a) where -- Representation type - type Rep (UserTree a) = + type Rep (UserTree a) = M1 D D1UserTree ( M1 C C1_0UserTree ( M1 S NoSelector (K1 P a) @@ -9284,10 +9284,10 @@ data C1_1UserTree instance Datatype D1UserTree where datatypeName _ = "UserTree" moduleName _ = "Main" - + instance Constructor C1_0UserTree where conName _ = "Node" - + instance Constructor C1_1UserTree where conName _ = "Leaf" @@ -9343,7 +9343,7 @@ exposed to the user: class Serialize a where put :: a -> [Bin] - + default put :: (Generic a, GSerialize (Rep a)) => a -> [Bit] put = gput . from @@ -9376,7 +9376,7 @@ carried out at let and where bindings. Switching off the dreaded Monomorphism Restriction -Haskell's monomorphism restriction (see +Haskell's monomorphism restriction (see Section 4.5.5 of the Haskell Report) @@ -9391,7 +9391,7 @@ can be completely switched off by As an experimental change, we are exploring the possibility of - making pattern bindings monomorphic; that is, not generalised at all. + making pattern bindings monomorphic; that is, not generalised at all. A pattern binding is a binding whose LHS has no function arguments, and is not a simple variable. For example: diff --git a/docs/users_guide/intro.xml b/docs/users_guide/intro.xml index 4d4849f..e219f90 100644 --- a/docs/users_guide/intro.xml +++ b/docs/users_guide/intro.xml @@ -35,7 +35,7 @@ possible while not making too much effort to optimise the generated code (although GHC probably isn't what you'd describe as a fast compiler :-). - + GHC's profiling system supports “cost centre stacks”: a way of seeing the profile of a Haskell program in a call-graph like structure. See for more @@ -104,7 +104,7 @@ - subscribe at: + subscribe at: http://www.haskell.org/mailman/listinfo/glasgow-haskell-users. @@ -145,7 +145,7 @@ - subscribe at: + subscribe at: http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs. @@ -169,7 +169,7 @@ - + cvs-ghc: @@ -178,7 +178,7 @@ other lists for other darcs repositories (most notably cvs-libraries). - + list email address: @@ -188,7 +188,7 @@ - subscribe at: + subscribe at: http://www.haskell.org/mailman/listinfo/cvs-ghc. @@ -273,7 +273,7 @@ - + Stable snapshots @@ -338,7 +338,7 @@ - + The version number of your copy of GHC can be found by invoking ghc with the ––version flag (see - + Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. @@ -31,7 +31,7 @@ and/or other materials provided with the distribution. - + Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/docs/users_guide/packages.xml b/docs/users_guide/packages.xml index 86df594..0a8412b 100644 --- a/docs/users_guide/packages.xml +++ b/docs/users_guide/packages.xml @@ -462,7 +462,7 @@ depends: array-0.2.0.1-9cbf76a576b6ee9c1f880cf171a0928d The purpose of the package ID is to detect problems caused by re-installing a package without also recompiling the packages that depend on it. Recompiling dependencies is necessary, - because the newly compiled package may have a differnt ABI + because the newly compiled package may have a different ABI (Application Binary Interface) than the previous version, even if both packages were built from the same source code using the same compiler. With package IDs, a recompiled @@ -985,7 +985,7 @@ ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf Versions of the Haskell libraries for use with GHCi may also - abe included: GHCi cannot load .a files + be included: GHCi cannot load .a files directly, instead it will look for an object file called HSfoo.o and load that. On some systems, the ghc-pkg tool can automatically @@ -1221,7 +1221,7 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix maintainerpackage specification - (optinoal freeform) The email address of the package's maintainer. + (optional freeform) The email address of the package's maintainer. @@ -1273,7 +1273,7 @@ haddock-html: /usr/share/doc/ghc/html/libraries/unix categorypackage specification - (optinoal freeform) Which category the package belongs to. This field + (optional freeform) Which category the package belongs to. This field is for use in conjunction with a future centralised package distribution framework, tentatively titled Hackage. diff --git a/docs/users_guide/parallel.xml b/docs/users_guide/parallel.xml index 92bad19..b8e7316 100644 --- a/docs/users_guide/parallel.xml +++ b/docs/users_guide/parallel.xml @@ -4,7 +4,7 @@ parallelism - GHC implements some major extensions to Haskell to support + GHC implements some major extensions to Haskell to support concurrent and parallel programming. Let us first establish terminology: Parallelism means running @@ -12,16 +12,16 @@ performance. Ideally, this should be done invisibly, and with no semantic changes. - Concurrency means implementing + Concurrency means implementing a program by using multiple I/O-performing threads. While a - concurrent Haskell program can run on a + concurrent Haskell program can run on a parallel machine, the primary goal of using concurrency is not to gain performance, but rather because that is the simplest and most direct way to write the program. Since the threads perform I/O, the semantics of the program is necessarily non-deterministic. - GHC supports both concurrency and parallelism. + GHC supports both concurrency and parallelism. @@ -55,7 +55,7 @@ the FFI with concurrency. Software Transactional Memory GHC now supports a new way to coordinate the activities of Concurrent - Haskell threads, called Software Transactional Memory (STM). The + Haskell threads, called Software Transactional Memory (STM). The STM papers are an excellent introduction to what STM is, and how to use @@ -78,7 +78,7 @@ All these features are described in the papers mentioned earlier. Parallel Haskell GHC includes support for running Haskell programs in parallel - on symmetric, shared-memory multi-processor + on symmetric, shared-memory multi-processor (SMP)SMP. By default GHC runs your program on one processor; if you want it to run in parallel you must link your program diff --git a/docs/users_guide/phases.xml b/docs/users_guide/phases.xml index dfa10a5..863838c 100644 --- a/docs/users_guide/phases.xml +++ b/docs/users_guide/phases.xml @@ -5,7 +5,7 @@ Replacing the program for one or more phases phases, changing - + You may specify that a different program be used for one of the phases of the compilation system, in place of whatever the ghc has wired into it. For example, you @@ -409,7 +409,7 @@ $ cat foo.hspp for Windows, solaris, etc.). - + arch_HOST_ARCH=1 @@ -437,7 +437,7 @@ $ cat foo.hspp strmod = "\ \ p \ \ " - + don't work with ; /usr/bin/cpp elides the backslash-newline pairs. @@ -452,7 +452,7 @@ $ cat foo.hspp Options affecting a Haskell pre-processor - + pre-processing: custom Pre-processor options @@ -855,11 +855,11 @@ $ cat foo.hspp However, if all the modules are otherwise up to date, you may need to force recompilation both of the module where the new "main" is, and of the module where the "main" function used to be; - ghc is not clever + ghc is not clever enough to figure out that they both need recompiling. You can force recompilation by removing the object file, or by using the flag. - + @@ -928,7 +928,7 @@ $ cat foo.hspp The threaded runtime system provides the following benefits: - + Parallelismparallelism on a multiprocessormultiprocessorSMP or multicoremulticore machine. See . @@ -1038,7 +1038,7 @@ $ cat foo.hspp sets the default heap size to 128MB. This will always be the default heap size for this program, unless the user overrides it. (Depending on the setting of the option, the user might - not have the ability to change RTS options at run-time, in which case + not have the ability to change RTS options at run-time, in which case would be the only way to set them.) @@ -1054,7 +1054,7 @@ $ cat foo.hspp On Windows, GHC normally generates a manifestmanifest - file when linking a binary. The + file when linking a binary. The manifest is placed in the file prog.exe.manifest where prog.exe is the name of the @@ -1074,7 +1074,7 @@ $ cat foo.hspp system using the security control panel, but GHC by default generates binaries that don't depend on the user having disabled installer detection. - + The disables generation of the manifest file. One reason to do this would be if you had a manifest file of your own, for example. @@ -1086,7 +1086,7 @@ $ cat foo.hspp , see below. - + @@ -1102,15 +1102,15 @@ $ cat foo.hspp ; to see exactly what GHC does to embed the manifest, use the flag. A GHC installation comes with its own copy of windres for this reason. - + See also () and + linkend="replacing-phases" />) and (). - + @@ -1125,7 +1125,7 @@ $ cat foo.hspp disk-space cost of creating this import library, which can be substantial - it might require as much space as the code itself, as Haskell DLLs tend to export lots of symbols. - + As long as you are happy to only be able to link to the DLL using GetProcAddress and friends, you can supply the flag to disable the creation of the import diff --git a/docs/users_guide/profiling.xml b/docs/users_guide/profiling.xml index 00bbcdb..01c7576 100644 --- a/docs/users_guide/profiling.xml +++ b/docs/users_guide/profiling.xml @@ -8,7 +8,7 @@ Glasgow Haskell comes with a time and space profiling system. Its purpose is to help you improve your understanding of your program's execution behaviour, so you can improve it. - + Any comments, suggestions and/or improvements you have are welcome. Recommended “profiling tricks” would be especially cool! @@ -39,18 +39,18 @@ RTS option - + Examine the generated profiling information, using one of GHC's profiling tools. The tool to use will depend on the kind of profiling information generated. - + - + Cost centres and cost-centre stacks - + GHC's profiling system assigns costs to cost centres. A cost is simply the time or space required to evaluate an expression. Cost centres are @@ -385,7 +385,7 @@ x = nfib 25 - + There are a few other profiling-related compilation options. Use them in addition to . These do not have to be used consistently @@ -406,7 +406,7 @@ x = nfib 25 it manually. - + : @@ -509,7 +509,7 @@ x = nfib 25 - + @@ -541,7 +541,7 @@ x = nfib 25 file, prog.ps. The hp2ps utility is described in detail in - . + . Display the heap profile using a postscript viewer such @@ -612,7 +612,7 @@ x = nfib 25 represent an approximation to the actual type. - + @@ -644,7 +644,7 @@ x = nfib 25 to display a profile by type but only for data produced by a certain module, or a profile by retainer for a certain type of data. Restrictions are specified as follows: - + @@ -702,7 +702,7 @@ x = nfib 25 types. - + cc,... @@ -776,7 +776,7 @@ x = nfib 25 state in addition to the space allocated for its stack (stacks normally start small and then grow as necessary). - + This includes the main thread, so using is a good way to see how much stack space the program is using. @@ -802,7 +802,7 @@ x = nfib 25 - + Retainer Profiling @@ -843,7 +843,7 @@ x = nfib 25 set MANY. The maximum set size defaults to 8 and can be altered with the RTS option: - + size @@ -883,7 +883,7 @@ x = nfib 25 prog +RTS -hr -hcB - + This trick isn't foolproof, because there might be other B closures in the heap which aren't the retainers we are interested in, but we've found this to be a useful technique @@ -1004,9 +1004,9 @@ x = nfib 25 heap profiles postscript, from heap profiles - + Usage: - + hp2ps [flags] [<file>[.hp]] @@ -1030,7 +1030,7 @@ hp2ps [flags] [<file>[.hp]] The flags are: - + @@ -1136,7 +1136,7 @@ hp2ps [flags] [<file>[.hp]] Use a small box for the title. - + @@ -1157,14 +1157,14 @@ hp2ps [flags] [<file>[.hp]] Generate colour output. - + Ignore marks. - + @@ -1177,7 +1177,7 @@ hp2ps [flags] [<file>[.hp]] Manipulating the hp file -(Notes kindly offered by Jan-Willhem Maessen.) +(Notes kindly offered by Jan-Willem Maessen.) The FOO.hp file produced when you ask for the @@ -1256,7 +1256,7 @@ profile of your program as it runs. Simply generate an incremental heap profile as described in the previous section. Run gv on your profile: - gv -watch -seascape FOO.ps + gv -watch -seascape FOO.ps If you forget the -watch flag you can still select "Watch file" from the "State" menu. Now each time you generate a new @@ -1292,7 +1292,7 @@ to re-read its input file: head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \ | hp2ps > FOO.ps kill -HUP $gvpsnum - done + done @@ -1335,7 +1335,7 @@ to re-read its input file: a yellow background indicates a part of the program that was never evaluated; a green background indicates an always-True expression and a red background indicates an always-False one. - + A small example: Reciprocation @@ -1381,10 +1381,10 @@ main = do -$ ghc -fhpc Recip.hs --make +$ ghc -fhpc Recip.hs --make - HPC index (.mix) files are placed placed in .hpc subdirectory. These can be considered like - the .hi files for HPC. + HPC index (.mix) files are placed in .hpc subdirectory. These can be considered like + the .hi files for HPC. $ ./Recip @@ -1396,8 +1396,8 @@ $ ./Recip $ hpc report Recip 80% expressions used (81/101) 12% boolean coverage (1/8) - 14% guards (1/7), 3 always True, - 1 always False, + 14% guards (1/7), 3 always True, + 1 always False, 2 unevaluated 0% 'if' conditions (0/1), 1 always False 100% qualifiers (0/0) @@ -1415,11 +1415,11 @@ writing Recip.hs.html hpc_index.html, hpc_index_alt.html, hpc_index_exp.html, hpc_index_fun.html. - + Options for instrumenting code for coverage - Turning on code coverage is easy, use the -fhpc flag. + Turning on code coverage is easy, use the -fhpc flag. Instrumented and non-instrumented can be freely mixed. When compiling the Main module GHC automatically detects when there is an hpc compiled file, and adds the correct initialization code. @@ -1431,9 +1431,9 @@ writing Recip.hs.html The hpc toolkit uses a cvs/svn/darcs-like interface, where a - single binary contains many function units. + single binary contains many function units. -$ hpc +$ hpc Usage: hpc COMMAND ... Commands: @@ -1456,9 +1456,9 @@ Others: In general, these options act on .tix file after an instrumented binary has generated it, which hpc acting as a conduit between the raw .tix file, and the more detailed reports - produced. + produced. - + The hpc tool assumes you are in the top-level directory of the location where you built your application, and the .tix @@ -1467,7 +1467,7 @@ Others: --srcdir multiple times to analyse programs compiled from difference locations, as is typical for packages. - + We now explain in more details the major modes of hpc. @@ -1477,8 +1477,8 @@ Others: all modules and packages are considered in generating report, unless include or exclude are used. The report is a summary unless the --per-module flag is used. The --xml-output option - allows for tools to use hpc to glean coverage. - + allows for tools to use hpc to glean coverage. + $ hpc help report Usage: hpc report [OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]] @@ -1518,8 +1518,8 @@ Options: hpc sum - hpc sum adds together any number of .tix files into a single - .tix file. hpc sum does not change the original .tix file; it generates a new .tix file. + hpc sum adds together any number of .tix files into a single + .tix file. hpc sum does not change the original .tix file; it generates a new .tix file. $ hpc help sum @@ -1535,10 +1535,10 @@ Options: hpc combine - hpc combine is the swiss army knife of hpc. It can be + hpc combine is the swiss army knife of hpc. It can be used to take the difference between .tix files, to subtract one .tix file from another, or to add two .tix files. hpc combine does not - change the original .tix file; it generates a new .tix file. + change the original .tix file; it generates a new .tix file. $ hpc help combine @@ -1557,11 +1557,11 @@ Options: hpc map hpc map inverts or zeros a .tix file. hpc map does not - change the original .tix file; it generates a new .tix file. + change the original .tix file; it generates a new .tix file. $ hpc help map -Usage: hpc map [OPTION] .. <TIX_FILE> +Usage: hpc map [OPTION] .. <TIX_FILE> Map a function over a single .tix file Options: @@ -1591,7 +1591,7 @@ Options: --hpcdir=DIR sub-directory that contains .mix files default .hpc [rarely used] --output=FILE output FILE -% hpc help draft +% hpc help draft Usage: hpc draft [OPTION] .. <TIX_FILE> Options: @@ -1660,7 +1660,7 @@ Options: for at link-time). This links in the debug version of the RTS, which includes the code for aggregating and reporting the results of ticky-ticky - profilng. + profiling. @@ -1678,7 +1678,7 @@ Options: the invocation foo +RTS -rfoo.ticky. - + foo +RTS -rfoo.ticky diff --git a/docs/users_guide/runtime_control.xml b/docs/users_guide/runtime_control.xml index be341b2..defae22 100644 --- a/docs/users_guide/runtime_control.xml +++ b/docs/users_guide/runtime_control.xml @@ -329,7 +329,7 @@ char *ghc_rts_opts = "-H128m -K1m"; with a message like “failed to mmap() memory below 2Gb”. If you need to use this option to get GHCi working on your machine, please file a bug. - + On 64-bit machines, the RTS needs to allocate memory in the low 2Gb of the address space. Support for this across @@ -495,7 +495,7 @@ char *ghc_rts_opts = "-H128m -K1m"; generation gen and higher. Omitting gen turns off the parallel GC completely, reverting to sequential GC. - + The default parallel GC settings are usually suitable for parallel programs (i.e. those using par, Strategies, or with multiple @@ -509,7 +509,7 @@ char *ghc_rts_opts = "-H128m -K1m"; restrict parallel GC to the old generation with -qg1. - + @@ -524,7 +524,7 @@ char *ghc_rts_opts = "-H128m -K1m"; generation gen and higher. Omitting gen disables load-balancing entirely. - + Load-balancing shares out the work of GC between the available cores. This is a good idea when the heap is @@ -817,7 +817,7 @@ char *ghc_rts_opts = "-H128m -K1m"; - The peak memory the RTS has allocated from the OS. + The peak memory the RTS has allocated from the OS. @@ -1012,12 +1012,12 @@ char *ghc_rts_opts = "-H128m -K1m"; - How many page faults occured this garbage collection. + How many page faults occurred this garbage collection. - How many page faults occured since the end of the last garbage + How many page faults occurred since the end of the last garbage collection. @@ -1209,7 +1209,7 @@ char *ghc_rts_opts = "-H128m -K1m"; - An RTS debugging flag; only availble if the program was + An RTS debugging flag; only available if the program was linked with the option. Various values of x are provided to enable debug messages and additional runtime sanity checks diff --git a/docs/users_guide/separate_compilation.xml b/docs/users_guide/separate_compilation.xml index 099a91f..e2c9c33 100644 --- a/docs/users_guide/separate_compilation.xml +++ b/docs/users_guide/separate_compilation.xml @@ -114,9 +114,9 @@ has been specified, then the object filename is dir/mod.osuf, where mod is the module name with - dots replaced by slashes. GHC will silently create the necessary directory + dots replaced by slashes. GHC will silently create the necessary directory structure underneath dir, if it does not - already exist. + already exist. @@ -273,7 +273,7 @@ If you use ghc --make and you don't use the , the name GHC will choose for the executable will be based on the name of the file - containing the module Main. + containing the module Main. Note that with GHC the Main module doesn't have to be put in file Main.hs. Thus both @@ -433,7 +433,7 @@ $ ghc -c parse/Foo.hs parse/Bar.hs gurgle/Bumble.hs -odir `uname -m` - + Keeping Intermediate Files intermediate files, saving @@ -693,22 +693,22 @@ $ ghc -c parse/Foo.hs parse/Bar.hs gurgle/Bumble.hs -odir `uname -m` This section explains how. Every cycle in the module import graph must be broken by a hs-boot file. - Suppose that modules A.hs and B.hs are Haskell source files, + Suppose that modules A.hs and B.hs are Haskell source files, thus: module A where import B( TB(..) ) - + newtype TA = MkTA Int - + f :: TB -> TA f (MkTB x) = MkTA x module B where import {-# SOURCE #-} A( TA(..) ) - + data TB = MkTB !Int - + g :: TA -> TB g (MkTA x) = MkTB x @@ -750,12 +750,12 @@ module A where ghc -c A.hs-boot -When a hs-boot file A.hs-boot +When a hs-boot file A.hs-boot is compiled, it is checked for scope and type errors. When its parent module A.hs is compiled, the two are compared, and an error is reported if the two are inconsistent. - + Just as compiling A.hs produces an interface file A.hi, and an object file @@ -793,7 +793,7 @@ When a hs-boot file A.hs-boot ghc -M will report an error if a cycle is found. - A module M that is + A module M that is {-# SOURCE #-}-imported in a program will usually also be ordinarily imported elsewhere. If not, ghc --make automatically adds M to the set of modules it tries to @@ -812,9 +812,9 @@ A hs-boot file need only contain the bare A hs-boot file is written in a subset of Haskell: The module header (including the export list), and import statements, are exactly as in -Haskell, and so are the scoping rules. +Haskell, and so are the scoping rules. Hence, to mention a non-Prelude type or class, you must import it. - + There must be no value declarations, but there can be type signatures for values. For example: @@ -823,7 +823,7 @@ values. For example: Fixity declarations are exactly as in Haskell. Type synonym declarations are exactly as in Haskell. - A data type declaration can either be given in full, exactly as in Haskell, or it + A data type declaration can either be given in full, exactly as in Haskell, or it can be given abstractly, by omitting the '=' sign and everything that follows. For example: data T a b @@ -835,7 +835,7 @@ can be given abstractly, by omitting the '=' sign and everything that follows. You can also write out the constructors but, if you do so, you must write it out precisely as in its real definition. - If you do not write out the constructors, you may need to give a kind + If you do not write out the constructors, you may need to give a kind annotation (), to tell GHC the kind of the type variable, if it is not "*". (In source files, this is worked out from the way the type variable is used in the constructors.) For example: @@ -938,7 +938,7 @@ Foo.o Foo.hc Foo.s : Baz.hi # Foo imports Baz brought up to date. To bring it up to date, make looks for a rule to do so; one of the preceding suffix rules does the job nicely. These dependencies - can be generated automatically by ghc; see + can be generated automatically by ghc; see @@ -967,7 +967,7 @@ depend : Makefile. In general, ghc -M Foo does the following. - For each module M in the set + For each module M in the set Foo plus all its imports (transitively), it adds to the Makefile: @@ -990,7 +990,7 @@ M.o : X.hi-boot (See for details of hi-boot style interface files.) - + If M imports multiple modules, then there will be multiple lines with M.o as the target. @@ -1127,7 +1127,7 @@ just in case they contain an instance declaration that matters to M. This would be a disaster in practice, so GHC tries to be clever. In particular, if an instance declaration is in the same module as the definition -of any type or class mentioned in the head of the instance declaration +of any type or class mentioned in the head of the instance declaration (the part after the “=>”; see ), then GHC has to visit that interface file anyway. Example: @@ -1178,8 +1178,8 @@ These considerations lead to the following definition of an orphan module: least one orphan rule. An instance declaration in a module M is an orphan instance if - orphan instance - + orphan instance + The class of the instance declaration is not declared in M, and @@ -1191,7 +1191,7 @@ These considerations lead to the following definition of an orphan module: - Only the instance head + Only the instance head counts. In the example above, it is not good enough for C's declaration to be in module A; it must be the declaration of D or T. @@ -1205,9 +1205,9 @@ These considerations lead to the following definition of an orphan module: -If you use the flag , GHC will warn you +If you use the flag , GHC will warn you if you are creating an orphan module. -Like any warning, you can switch the warning off with , +Like any warning, you can switch the warning off with , and will make the compilation fail if the warning is issued. diff --git a/docs/users_guide/shared_libs.xml b/docs/users_guide/shared_libs.xml index 29dcb37..5c258d4 100644 --- a/docs/users_guide/shared_libs.xml +++ b/docs/users_guide/shared_libs.xml @@ -113,8 +113,8 @@ ghc --make -dynamic Main.hs Building Haskell code into a shared library is a good way to include Haskell code in a larger mixed-language project. While with static linking it is recommended to use GHC to perform the final link step, - with shared libaries a Haskell library can be treated just like any - other shared libary. The linking can be done using the normal system C + with shared libraries a Haskell library can be treated just like any + other shared library. The linking can be done using the normal system C compiler or linker. @@ -138,7 +138,7 @@ ghc --make -dynamic -shared -fPIC Foo.hs -o libfoo.so package. The -fPIC flag is required for all code that will end up in a shared library. The -shared flag specifies to make a shared library rather than a program. To make - this clearer we can break this down into separate compliation and link + this clearer we can break this down into separate compilation and link steps: ghc -dynamic -fPIC -c Foo.hs @@ -179,7 +179,7 @@ ghc -dynamic -shared Foo.o -o libfoo.so is to use a "runtime path" or "rpath" embedded into programs and libraries themselves. These paths can either be absolute paths or on at least Linux and Solaris they can be paths relative to the program or - libary itself. In principle this makes it possible to construct fully + library itself. In principle this makes it possible to construct fully relocatable sets of programs and libraries. diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index df01521..2828c6a 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -78,7 +78,7 @@ Hello World! Options overview - + GHC's behaviour is controlled by options, which for historical reasons are also sometimes referred to as command-line flags or arguments. @@ -86,11 +86,11 @@ Hello World! Command-line arguments - + structure, command-line command-linearguments argumentscommand-line - + An invocation of GHC takes the following form: @@ -112,7 +112,7 @@ ghc [argument...] Command line options in source files - + source-file options Sometimes it is useful to make the connection between a @@ -130,7 +130,7 @@ ghc [argument...] module X where ... - + OPTIONS_GHC is a file-header pragma (see ). @@ -163,7 +163,7 @@ module X where for more details. - + Static, Dynamic, and Mode options staticoptions @@ -204,14 +204,14 @@ module X where - + The flag reference tables () lists the status of each flag. There are a few flags that are static except that they can also be used with GHCi's :set command; these are listed as “static/:set” in the - table. + table. @@ -266,7 +266,7 @@ module X where compiler. - + .ll @@ -336,7 +336,7 @@ module X where more detail in . - + ghc ––make @@ -375,7 +375,7 @@ module X where more details. - + @@ -531,7 +531,7 @@ module X where Using <command>ghc</command> <option>––make</option> separate compilation - + In this mode, GHC will build a multi-module Haskell program by following dependencies from one or more root modules (usually just Main). For example, if your @@ -583,7 +583,7 @@ ghc Main.hs source. - + Any of the command-line options described in the rest of this chapter can be used with , but note that any options @@ -596,7 +596,7 @@ ghc Main.hs (say, some auxiliary C code), then the object files can be given on the command line and GHC will include them when linking the executable. - + Note that GHC can only follow dependencies if it has the source file available, so if your program includes a module for which there is no source file, even if you have an object and an @@ -609,7 +609,7 @@ ghc Main.hs to add directories to the search path (see ). - + Expression evaluation mode @@ -633,7 +633,7 @@ ghc -e expr ghc -e Main.main Main.hs - + or we can just use this mode to evaluate expressions in the context of the Prelude: @@ -646,22 +646,22 @@ olleh Batch compiler mode - + In batch mode, GHC will compile one or more source files given on the command line. - + The first phase to run is determined by each input-file suffix, and the last phase is determined by a flag. If no relevant flag is present, then go all the way through to linking. This table summarises: - + - + Phase of the compilation system @@ -677,7 +677,7 @@ olleh - .hs - + C pre-processor (opt.) .hs (with @@ -685,28 +685,28 @@ olleh .hspp - + Haskell compiler .hs , .hc, .s - + C compiler (opt.) .hc or .c .s - + assembler .s .o - + linker other @@ -716,17 +716,17 @@ olleh - + - + Thus, a common invocation would be: ghc -c Foo.hs - + to compile the Haskell source file Foo.hs to an object file Foo.o. @@ -741,7 +741,7 @@ ghc -c Foo.hs flag turns it on. See for more details. - + Note: The option -E option runs just the pre-processing passes of the compiler, dumping the result in a file. @@ -800,7 +800,7 @@ ghc -c Foo.hs verify. - + n @@ -812,7 +812,7 @@ ghc -c Foo.hs argument. Specifying on its own is equivalent to , and the other levels have the following meanings: - + @@ -862,7 +862,7 @@ ghc -c Foo.hs - + @@ -1000,7 +1000,7 @@ ghc -c Foo.hs : - Makes any warning into a fatal error. Useful so that you don't + Makes any warning into a fatal error. Useful so that you don't miss warnings when doing batch compilation. @@ -1205,18 +1205,18 @@ foreign import "&f" f :: FunPtr t - , + , : - + incomplete patterns, warning patterns, incomplete - The option warns + The option warns about places where - a pattern-match might fail at runtime. + a pattern-match might fail at runtime. The function g below will fail when applied to non-empty lists, so the compiler will emit a warning about @@ -1228,7 +1228,7 @@ g [] = 2 This option isn't enabled by default because it can be a bit noisy, and it doesn't always indicate a bug in the program. However, it's generally considered good practice - to cover all the cases in your functions, and it is switched + to cover all the cases in your functions, and it is switched on by . The flag is @@ -1296,9 +1296,9 @@ f foo = foo { x = 6 } - This flag warns if you use an unqualified + This flag warns if you use an unqualified import declaration - that does not explicitly list the entities brought into scope. For + that does not explicitly list the entities brought into scope. For example @@ -1339,7 +1339,7 @@ module M where complexFn :: a -> a -> String complexFn x y = ... _simpleFn ... - The idea is that: (a) users of the class will only call complexFn; + The idea is that: (a) users of the class will only call complexFn; never _simpleFn; and (b) instance declarations can define either complexFn or _simpleFn. @@ -1379,7 +1379,7 @@ module M where shadowing, warning - + This option causes a warning to be emitted whenever an inner-scope value has the same name as an outer-scope value, i.e. the inner value shadows the outer one. This can catch @@ -1400,8 +1400,8 @@ module M where orphan instances, warning orphan rules, warning - - This option causes a warning to be emitted whenever the + + This option causes a warning to be emitted whenever the module contains an "orphan" instance declaration or rewrite rule. An instance declaration is an orphan if it appears in a module in which neither the class nor the type being instanced are declared @@ -1410,7 +1410,7 @@ module M where orphans is called an orphan module. The trouble with orphans is that GHC must pro-actively read the interface files for all orphan modules, just in case their instances or rules - play a role, whether or not the module's interface would otherwise + play a role, whether or not the module's interface would otherwise be of any use. See for details. @@ -1498,8 +1498,8 @@ f "2" = 2 which are unused. For top-level functions, the warning is only given if the binding is not exported. A definition is regarded as "used" if (a) it is exported, or (b) it is - mentioned in the right hand side of another definition that is used, or (c) the - function it defines begins with an underscore. The last case provides a + mentioned in the right hand side of another definition that is used, or (c) the + function it defines begins with an underscore. The last case provides a way to suppress unused-binding warnings selectively. Notice that a variable is reported as unused even if it appears in the right-hand side of another @@ -1547,7 +1547,7 @@ f "2" = 2 unused do binding, warning do binding, unused - Report expressions occuring in do and mdo blocks + Report expressions occurring in do and mdo blocks that appear to silently throw information away. For instance do { mapM popInt xs ; return 10 } would report the first statement in the do block as suspicious, @@ -1572,7 +1572,7 @@ f "2" = 2 apparently erroneous do binding, warning do binding, apparently erroneous - Report expressions occuring in do and mdo blocks + Report expressions occurring in do and mdo blocks that appear to lack a binding. For instance do { return (popInt 10) ; return 10 } would report the first statement in the do block as suspicious, @@ -1858,7 +1858,7 @@ f "2" = 2 State# token as argument is considered to be single-entry, hence it is considered OK to inline things inside it. This can improve performance of IO and ST monad code, but it - runs the risk of reducing sharing. + runs the risk of reducing sharing. @@ -1922,10 +1922,10 @@ f "2" = 2 unfolding, controlling - (Default: 45) Governs the maximum size that GHC will + (Default: 45) Governs the maximum size that GHC will allow a function unfolding to be. (An unfolding has a “size” that reflects the cost in terms of - “code bloat” of expanding that unfolding at + “code bloat” of expanding that unfolding at a call site. A bigger function would be assigned a bigger cost.) @@ -1959,10 +1959,10 @@ f "2" = 2 - + - - &phases; + + &phases; &shared_libs; @@ -2022,7 +2022,7 @@ f "2" = 2 use GHC to compile and run parallel programs, in we describe the language features that affect parallelism. - + Compile-time options for SMP parallelism @@ -2030,7 +2030,7 @@ f "2" = 2 linked with the option (see ). Additionally, the following compiler options affect parallelism: - + @@ -2087,7 +2087,7 @@ f "2" = 2 results you find.. For example, on a dual-core machine we would probably use +RTS -N2 -RTS. - + Omitting x, i.e. +RTS -N -RTS, lets the runtime choose the value of x itself @@ -2149,7 +2149,7 @@ f "2" = 2 - + Hints for using SMP parallelism @@ -2216,14 +2216,14 @@ f "2" = 2 intermediate code generation - GHC can dump its optimized intermediate code (said to be in “Core” format) + GHC can dump its optimized intermediate code (said to be in “Core” format) to a file as a side-effect of compilation. Non-GHC back-end tools can read and process Core files; these files have the suffix .hcr. The Core format is described in - An External Representation for the GHC Core Language, + An External Representation for the GHC Core Language, and sample tools for manipulating Core files (in Haskell) are available in the extcore package on Hackage. Note that the format of .hcr - files is different from the Core output format that GHC generates + files is different from the Core output format that GHC generates for debugging purposes (), though the two formats appear somewhat similar. The Core format natively supports notes which you can add to diff --git a/docs/users_guide/win32-dlls.xml b/docs/users_guide/win32-dlls.xml index 44f589a..ad1c788 100644 --- a/docs/users_guide/win32-dlls.xml +++ b/docs/users_guide/win32-dlls.xml @@ -23,7 +23,7 @@ interpret the filename as two, "c:\\Program" and "Files\\Haskell\\Project.hs".