summaryrefslogtreecommitdiff
path: root/compiler/codeGen
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2018-03-21 17:02:21 -0400
committerJoachim Breitner <mail@joachim-breitner.de>2018-03-21 17:02:21 -0400
commit4a47fd33d2f16070d4fe8bd32a104587608061cd (patch)
tree204afacf3bf4177de01b8f2778f4154c26bf578b /compiler/codeGen
parentc663b715b6201d460e8bf2b6fb26e61c700384e0 (diff)
parent0aa7d8796a95298e906ea81fe4a52590d75c2e47 (diff)
downloadhaskell-wip/T14068.tar.gz
Merge branch 'wip/T14951' into wip/T14068wip/T14068
Diffstat (limited to 'compiler/codeGen')
-rw-r--r--compiler/codeGen/CgUtils.hs4
-rw-r--r--compiler/codeGen/StgCmmBind.hs4
-rw-r--r--compiler/codeGen/StgCmmExpr.hs22
-rw-r--r--compiler/codeGen/StgCmmForeign.hs8
-rw-r--r--compiler/codeGen/StgCmmHeap.hs4
-rw-r--r--compiler/codeGen/StgCmmMonad.hs13
-rw-r--r--compiler/codeGen/StgCmmProf.hs4
-rw-r--r--compiler/codeGen/StgCmmTicky.hs4
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 )