[commit: ghc] master: cmm: Remove unnecessary HsVersion.h includes (7ad72eb)

git at git.haskell.org git at git.haskell.org
Tue Feb 6 19:22:15 UTC 2018


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7ad72eb39d1becc9fdbc99d4969f5b9b182ddf93/ghc

>---------------------------------------------------------------

commit 7ad72eb39d1becc9fdbc99d4969f5b9b182ddf93
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Tue Feb 6 13:26:29 2018 -0500

    cmm: Remove unnecessary HsVersion.h includes
    
    Test Plan: ./validate
    
    Reviewers: goldfire, bgamari, simonmar
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4367


>---------------------------------------------------------------

7ad72eb39d1becc9fdbc99d4969f5b9b182ddf93
 compiler/cmm/Bitmap.hs             | 5 +----
 compiler/cmm/Cmm.hs                | 2 --
 compiler/cmm/CmmBuildInfoTables.hs | 4 +---
 compiler/cmm/CmmCallConv.hs        | 4 ----
 compiler/cmm/CmmLayoutStack.hs     | 4 +---
 compiler/cmm/CmmMachOp.hs          | 4 ----
 compiler/cmm/CmmOpt.hs             | 4 ----
 compiler/cmm/CmmType.hs            | 3 ---
 compiler/cmm/MkGraph.hs            | 2 --
 compiler/cmm/SMRep.hs              | 3 ---
 10 files changed, 3 insertions(+), 32 deletions(-)

diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs
index 6ff6193..e6ac15f 100644
--- a/compiler/cmm/Bitmap.hs
+++ b/compiler/cmm/Bitmap.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
 
 --
 -- (c) The University of Glasgow 2003-2006
@@ -15,9 +15,6 @@ module Bitmap (
         seqBitmap,
   ) where
 
-#include "HsVersions.h"
-#include "../includes/MachDeps.h"
-
 import GhcPrelude
 
 import SMRep
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index c9ecda8..9f83273 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -41,8 +41,6 @@ import Outputable
 
 import Data.Word        ( Word8 )
 
-#include "HsVersions.h"
-
 -----------------------------------------------------------------------------
 --  Cmm, GenCmm
 -----------------------------------------------------------------------------
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index a482306..dc5cfd6 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -1,12 +1,10 @@
-{-# LANGUAGE BangPatterns, CPP, GADTs #-}
+{-# LANGUAGE BangPatterns, GADTs #-}
 
 module CmmBuildInfoTables
     ( CAFSet, CAFEnv, cafAnal
     , doSRTs, TopSRT, emptySRT, isEmptySRT, srtToData )
 where
 
-#include "HsVersions.h"
-
 import GhcPrelude hiding (succ)
 
 import Hoopl.Block
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index c32710e..e1067e9 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module CmmCallConv (
   ParamLocation(..),
   assignArgumentsPos,
@@ -7,8 +5,6 @@ module CmmCallConv (
   realArgRegsCover
 ) where
 
-#include "HsVersions.h"
-
 import GhcPrelude
 
 import CmmExpr
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index b2d74b2..6cf8f8e 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP, RecordWildCards, GADTs #-}
+{-# LANGUAGE BangPatterns, RecordWildCards, GADTs #-}
 module CmmLayoutStack (
        cmmLayoutStack, setInfoTableStackMap
   ) where
@@ -39,8 +39,6 @@ import Data.Array as Array
 import Data.Bits
 import Data.List (nub)
 
-#include "HsVersions.h"
-
 {- Note [Stack Layout]
 
 The job of this pass is to
diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index 8ac4a6f..9203911 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/compiler/cmm/CmmMachOp.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module CmmMachOp
     ( MachOp(..)
     , pprMachOp, isCommutableMachOp, isAssociativeMachOp
@@ -28,8 +26,6 @@ module CmmMachOp
    )
 where
 
-#include "HsVersions.h"
-
 import GhcPrelude
 
 import CmmType
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index f9b1260..6b4d792 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 -- The default iteration limit is a bit too low for the definitions
 -- in this module.
 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}
@@ -19,8 +17,6 @@ module CmmOpt (
         cmmMachOpFoldM
  ) where
 
-#include "HsVersions.h"
-
 import GhcPrelude
 
 import CmmUtils
diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index cb15dc7..0538b9f 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 module CmmType
     ( CmmType   -- Abstract
     , b8, b16, b32, b64, b128, b256, b512, f32, f64, bWord, bHalfWord, gcWord
@@ -29,7 +27,6 @@ module CmmType
    )
 where
 
-#include "HsVersions.h"
 
 import GhcPrelude
 
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index f130f1b..d9f1402 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -42,8 +42,6 @@ import Control.Monad
 import Data.List
 import Data.Maybe
 
-#include "HsVersions.h"
-
 
 -----------------------------------------------------------------------------
 -- Building Graphs
diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs
index 1469ae1..9f8a49b 100644
--- a/compiler/cmm/SMRep.hs
+++ b/compiler/cmm/SMRep.hs
@@ -47,9 +47,6 @@ module SMRep (
         pprWord8String, stringToWord8s
     ) where
 
-#include "../HsVersions.h"
-#include "../includes/MachDeps.h"
-
 import GhcPrelude
 
 import BasicTypes( ConTagZ )



More information about the ghc-commits mailing list