diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/CgUtils.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 22 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 8 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmMonad.hs | 13 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 4 |
8 files changed, 22 insertions, 41 deletions
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index c20f1fd1d0..6a2840294a 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, GADTs #-} +{-# LANGUAGE GADTs #-} ----------------------------------------------------------------------------- -- @@ -10,8 +10,6 @@ module CgUtils ( fixStgRegisters ) where -#include "HsVersions.h" - import GhcPrelude import CodeGen.Platform diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 9ef552d336..b29394da6f 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- -- -- Stg to C-- code generation: bindings @@ -15,8 +13,6 @@ module StgCmmBind ( pushUpdateFrame, emitUpdateFrame ) where -#include "HsVersions.h" - import GhcPrelude hiding ((<*>)) import StgCmmExpr diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 3fcc935121..22fcfaf412 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} ----------------------------------------------------------------------------- -- @@ -61,7 +60,8 @@ cgExpr :: StgExpr -> FCode ReturnKind cgExpr (StgApp fun args) = cgIdApp fun args -{- seq# a s ==> a -} +-- seq# a s ==> a +-- See Note [seq# magic] in PrelRules cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] @@ -409,7 +409,8 @@ cgCase (StgApp v []) bndr alt_type@(PrimAlt _) alts ; v_info <- getCgIdInfo v ; emitAssign (CmmLocal (idToReg dflags (NonVoid bndr))) (idInfoToAmode v_info) - ; bindArgToReg (NonVoid bndr) + -- Add bndr to the environment + ; _ <- bindArgToReg (NonVoid bndr) ; cgAlts (NoGcInAlts,AssignedDirectly) (NonVoid bndr) alt_type alts } where reps_compatible = ((==) `on` (primRepSlot . idPrimRep)) v bndr @@ -435,7 +436,8 @@ it would be better to invoke some kind of panic function here. cgCase scrut@(StgApp v []) _ (PrimAlt _) _ = do { dflags <- getDynFlags ; mb_cc <- maybeSaveCostCentre True - ; withSequel (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut) + ; _ <- withSequel + (AssignTo [idToReg dflags (NonVoid v)] False) (cgExpr scrut) ; restoreCurrentCostCentre mb_cc ; emitComment $ mkFastString "should be unreachable code" ; l <- newBlockId @@ -446,13 +448,14 @@ cgCase scrut@(StgApp v []) _ (PrimAlt _) _ {- Note [Handle seq#] ~~~~~~~~~~~~~~~~~~~~~ -case seq# a s of v - (# s', a' #) -> e +See Note [seq# magic] in PrelRules. +The special case for seq# in cgCase does this: + case seq# a s of v + (# s', a' #) -> e ==> - -case a of v - (# s', a' #) -> e + case a of v + (# s', a' #) -> e (taking advantage of the fact that the return convention for (# State#, a #) is the same as the return convention for just 'a') @@ -460,6 +463,7 @@ is the same as the return convention for just 'a') cgCase (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _) bndr alt_type alts = -- Note [Handle seq#] + -- And see Note [seq# magic] in PrelRules -- Use the same return convention as vanilla 'a'. cgCase (StgApp a []) bndr alt_type alts diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index d0ad17f59b..c1103e7d77 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- -- -- Code generation for foreign calls. @@ -20,8 +18,6 @@ module StgCmmForeign ( emitCloseNursery, ) where -#include "HsVersions.h" - import GhcPrelude hiding( succ, (<*>) ) import StgSyn @@ -408,8 +404,8 @@ Opening the nursery corresponds to the following code: @ tso = CurrentTSO; cn = CurrentNursery; - bdfree = CurrentNuresry->free; - bdstart = CurrentNuresry->start; + bdfree = CurrentNursery->free; + bdstart = CurrentNursery->start; // We *add* the currently occupied portion of the nursery block to // the allocation limit, because we will subtract it again in diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 07633ed4ae..3be35b35fa 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- -- -- Stg to C--: heap management functions @@ -22,8 +20,6 @@ module StgCmmHeap ( emitSetDynHdr ) where -#include "HsVersions.h" - import GhcPrelude hiding ((<*>)) import StgSyn diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index 7c3864296c..cc941a2e57 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, GADTs, UnboxedTuples #-} +{-# LANGUAGE GADTs, UnboxedTuples #-} ----------------------------------------------------------------------------- -- @@ -58,8 +58,6 @@ module StgCmmMonad ( CgInfoDownwards(..), CgState(..) -- non-abstract ) where -#include "HsVersions.h" - import GhcPrelude hiding( sequence, succ ) import Cmm @@ -79,6 +77,7 @@ import Unique import UniqSupply import FastString import Outputable +import Util import Control.Monad import Data.List @@ -696,11 +695,9 @@ emitLabel id = do tscope <- getTickScope emitCgStmt (CgLabel id tscope) emitComment :: FastString -> FCode () -#if 0 /* def DEBUG */ -emitComment s = emitCgStmt (CgStmt (CmmComment s)) -#else -emitComment _ = return () -#endif +emitComment s + | debugIsOn = emitCgStmt (CgStmt (CmmComment s)) + | otherwise = return () emitTick :: CmmTickish -> FCode () emitTick = emitCgStmt . CgStmt . CmmTick diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index a0bca5d661..15c31ca59c 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- -- -- Code generation for profiling @@ -25,8 +23,6 @@ module StgCmmProf ( ldvEnter, ldvEnterClosure, ldvRecordCreate ) where -#include "HsVersions.h" - import GhcPrelude import StgCmmClosure diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index a7d158ce3a..8f3074856a 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- @@ -104,8 +104,6 @@ module StgCmmTicky ( tickySlowCall, tickySlowCallPat, ) where -#include "HsVersions.h" - import GhcPrelude import StgCmmArgRep ( slowCallPattern , toArgRep , argRepString ) |