summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas Miedema <thomasmiedema@gmail.com>2015-08-21 10:44:54 +0200
committerBen Gamari <ben@smart-cactus.org>2015-08-21 15:44:21 +0200
commit2f29ebbb6f8c914f2bba624f3edcc259274df8af (patch)
treec523018ed23dd32e45697fe177d6df5ad4b59b50
parent3452473b4bb180ba327520067b8c6f2a8d6c4f4b (diff)
downloadhaskell-2f29ebbb6f8c914f2bba624f3edcc259274df8af.tar.gz
Refactor: delete most of the module FastTypes
This reverses some of the work done in #1405, and goes back to the assumption that the bootstrap compiler understands GHC-haskell. In particular: * use MagicHash instead of _ILIT and _CLIT * pattern matching on I# if possible, instead of using iUnbox unnecessarily * use Int#/Char#/Addr# instead of the following type synonyms: - type FastInt = Int# - type FastChar = Char# - type FastPtr a = Addr# * inline the following functions: - iBox = I# - cBox = C# - fastChr = chr# - fastOrd = ord# - eqFastChar = eqChar# - shiftLFastInt = uncheckedIShiftL# - shiftR_FastInt = uncheckedIShiftRL# - shiftRLFastInt = uncheckedIShiftRL# * delete the following unused functions: - minFastInt - maxFastInt - uncheckedIShiftRA# - castFastPtr - panicDocFastInt and pprPanicFastInt * rename panicFastInt back to panic# These functions remain, since they actually do something: * iUnbox * bitAndFastInt * bitOrFastInt Test Plan: validate Reviewers: austin, bgamari Subscribers: rwbarton Differential Revision: https://phabricator.haskell.org/D1141 GHC Trac Issues: #1405
-rw-r--r--compiler/basicTypes/Literal.hs33
-rw-r--r--compiler/basicTypes/Name.hs24
-rw-r--r--compiler/basicTypes/UniqSupply.hs19
-rw-r--r--compiler/basicTypes/Unique.hs72
-rw-r--r--compiler/basicTypes/Var.hs32
-rw-r--r--compiler/basicTypes/VarEnv.hs29
-rw-r--r--compiler/cmm/CmmOpt.hs24
-rw-r--r--compiler/coreSyn/CoreUnfold.hs68
-rw-r--r--compiler/ghc.cabal.in1
-rw-r--r--compiler/ghc.mk1
-rw-r--r--compiler/hsSyn/HsExpr.hs2
-rw-r--r--compiler/main/GhcPlugins.hs3
-rw-r--r--compiler/nativeGen/PPC/Regs.hs33
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs52
-rw-r--r--compiler/nativeGen/SPARC/Regs.hs45
-rw-r--r--compiler/nativeGen/TargetReg.hs5
-rw-r--r--compiler/nativeGen/X86/Regs.hs42
-rw-r--r--compiler/prelude/PrimOp.hs20
-rw-r--r--compiler/profiling/CostCentre.hs14
-rw-r--r--compiler/utils/FastFunctions.hs31
-rw-r--r--compiler/utils/FastString.hs41
-rw-r--r--compiler/utils/FastTypes.hs138
-rw-r--r--compiler/utils/Outputable.hs9
-rw-r--r--compiler/utils/Panic.hs15
-rw-r--r--compiler/utils/StringBuffer.hs23
-rw-r--r--compiler/utils/Util.hs25
-rw-r--r--utils/genprimopcode/Main.hs4
27 files changed, 268 insertions, 537 deletions
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs
index ced05a4d2f..5f3b75dafa 100644
--- a/compiler/basicTypes/Literal.hs
+++ b/compiler/basicTypes/Literal.hs
@@ -48,7 +48,6 @@ import PrelNames
import Type
import TyCon
import Outputable
-import FastTypes
import FastString
import BasicTypes
import Binary
@@ -422,21 +421,21 @@ cmpLit (MachFloat a) (MachFloat b) = a `compare` b
cmpLit (MachDouble a) (MachDouble b) = a `compare` b
cmpLit (MachLabel a _ _) (MachLabel b _ _) = a `compare` b
cmpLit (LitInteger a _) (LitInteger b _) = a `compare` b
-cmpLit lit1 lit2 | litTag lit1 <# litTag lit2 = LT
- | otherwise = GT
-
-litTag :: Literal -> FastInt
-litTag (MachChar _) = _ILIT(1)
-litTag (MachStr _) = _ILIT(2)
-litTag (MachNullAddr) = _ILIT(3)
-litTag (MachInt _) = _ILIT(4)
-litTag (MachWord _) = _ILIT(5)
-litTag (MachInt64 _) = _ILIT(6)
-litTag (MachWord64 _) = _ILIT(7)
-litTag (MachFloat _) = _ILIT(8)
-litTag (MachDouble _) = _ILIT(9)
-litTag (MachLabel _ _ _) = _ILIT(10)
-litTag (LitInteger {}) = _ILIT(11)
+cmpLit lit1 lit2 | litTag lit1 < litTag lit2 = LT
+ | otherwise = GT
+
+litTag :: Literal -> Int
+litTag (MachChar _) = 1
+litTag (MachStr _) = 2
+litTag (MachNullAddr) = 3
+litTag (MachInt _) = 4
+litTag (MachWord _) = 5
+litTag (MachInt64 _) = 6
+litTag (MachWord64 _) = 7
+litTag (MachFloat _) = 8
+litTag (MachDouble _) = 9
+litTag (MachLabel _ _ _) = 10
+litTag (LitInteger {}) = 11
{-
Printing
@@ -535,4 +534,4 @@ hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-- since we use * to combine hash values
hashFS :: FastString -> Int
-hashFS s = iBox (uniqueOfFS s)
+hashFS s = uniqueOfFS s
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 506b60fb95..79f14ab93c 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -86,7 +86,6 @@ import Util
import Maybes
import Binary
import DynFlags
-import FastTypes
import FastString
import Outputable
@@ -105,8 +104,7 @@ import Data.Data
data Name = Name {
n_sort :: NameSort, -- What sort of name it is
n_occ :: !OccName, -- Its occurrence name
- n_uniq :: FastInt, -- UNPACK doesn't work, recursive type
---(note later when changing Int# -> FastInt: is that still true about UNPACK?)
+ n_uniq :: {-# UNPACK #-} !Int,
n_loc :: !SrcSpan -- Definition site
}
deriving Typeable
@@ -184,7 +182,7 @@ nameModule :: Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
-nameUnique name = mkUniqueGrimily (iBox (n_uniq name))
+nameUnique name = mkUniqueGrimily (n_uniq name)
nameOccName name = n_occ name
nameSrcLoc name = srcSpanStart (n_loc name)
nameSrcSpan name = n_loc name
@@ -309,7 +307,7 @@ isSystemName _ = False
-- | Create a name which is (for now at least) local to the current module and hence
-- does not need a 'Module' to disambiguate it from other 'Name's
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
-mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq
+mkInternalName uniq occ loc = Name { n_uniq = getKey uniq
, n_sort = Internal
, n_occ = occ
, n_loc = loc }
@@ -324,12 +322,12 @@ mkInternalName uniq occ loc = Name { n_uniq = getKeyFastInt uniq
mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })
- = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal
+ = Name { n_uniq = getKey uniq, n_sort = Internal
, n_occ = occ, n_loc = loc }
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
- = Name { n_uniq = getKeyFastInt uniq, n_sort = Internal
+ = Name { n_uniq = getKey uniq, n_sort = Internal
, n_occ = derive_occ occ, n_loc = loc }
-- | Create a name which definitely originates in the given module
@@ -338,13 +336,13 @@ mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
-- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName
-- with some fresh unique without populating the Name Cache
mkExternalName uniq mod occ loc
- = Name { n_uniq = getKeyFastInt uniq, n_sort = External mod,
+ = Name { n_uniq = getKey uniq, n_sort = External mod,
n_occ = occ, n_loc = loc }
-- | Create a name which is actually defined by the compiler itself
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName mod occ uniq thing built_in
- = Name { n_uniq = getKeyFastInt uniq,
+ = Name { n_uniq = getKey uniq,
n_sort = WiredIn mod thing built_in,
n_occ = occ, n_loc = wiredInSrcSpan }
@@ -353,7 +351,7 @@ mkSystemName :: Unique -> OccName -> Name
mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan
mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
-mkSystemNameAt uniq occ loc = Name { n_uniq = getKeyFastInt uniq, n_sort = System
+mkSystemNameAt uniq occ loc = Name { n_uniq = getKey uniq, n_sort = System
, n_occ = occ, n_loc = loc }
mkSystemVarName :: Unique -> FastString -> Name
@@ -371,7 +369,7 @@ mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of. If you know what I mean.
setNameUnique :: Name -> Unique -> Name
-setNameUnique name uniq = name {n_uniq = getKeyFastInt uniq}
+setNameUnique name uniq = name {n_uniq = getKey uniq}
-- This is used for hsigs: we want to use the name of the originally exported
-- entity, but edit the location to refer to the reexport site
@@ -410,7 +408,7 @@ mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
-}
cmpName :: Name -> Name -> Ordering
-cmpName n1 n2 = iBox (n_uniq n1) `compare` iBox (n_uniq n2)
+cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
stableNameCmp :: Name -> Name -> Ordering
-- Compare lexicographically
@@ -505,7 +503,7 @@ pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
External mod -> pprExternal sty uniq mod occ False UserSyntax
System -> pprSystem sty uniq occ
Internal -> pprInternal sty uniq occ
- where uniq = mkUniqueGrimily (iBox u)
+ where uniq = mkUniqueGrimily u
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ is_wired is_builtin
diff --git a/compiler/basicTypes/UniqSupply.hs b/compiler/basicTypes/UniqSupply.hs
index 3d0573dba0..67248db72d 100644
--- a/compiler/basicTypes/UniqSupply.hs
+++ b/compiler/basicTypes/UniqSupply.hs
@@ -25,12 +25,13 @@ module UniqSupply (
) where
import Unique
-import FastTypes
import GHC.IO
import MonadUtils
import Control.Monad
+import Data.Bits
+import Data.Char
{-
************************************************************************
@@ -45,7 +46,7 @@ import Control.Monad
-- also manufacture an arbitrary number of further 'UniqueSupply' values,
-- which will be distinct from the first and from all others.
data UniqSupply
- = MkSplitUniqSupply FastInt -- make the Unique with this
+ = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this
UniqSupply UniqSupply
-- when split => these two supplies
@@ -67,7 +68,7 @@ takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
mkSplitUniqSupply c
- = case fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24) of
+ = case ord c `shiftL` 24 of
mask -> let
-- here comes THE MAGIC:
@@ -75,11 +76,11 @@ mkSplitUniqSupply c
mk_supply
-- NB: Use unsafeInterleaveIO for thread-safety.
= unsafeInterleaveIO (
- genSym >>= \ u_ -> case iUnbox u_ of { u -> (
+ genSym >>= \ u ->
mk_supply >>= \ s1 ->
mk_supply >>= \ s2 ->
- return (MkSplitUniqSupply (mask `bitOrFastInt` u) s1 s2)
- )})
+ return (MkSplitUniqSupply (mask .|. u) s1 s2)
+ )
in
mk_supply
@@ -88,9 +89,9 @@ foreign import ccall unsafe "genSym" genSym :: IO Int
splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
listSplitUniqSupply (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
-uniqFromSupply (MkSplitUniqSupply n _ _) = mkUniqueGrimily (iBox n)
-uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily (iBox n) : uniqsFromSupply s2
-takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily (iBox n), s1)
+uniqFromSupply (MkSplitUniqSupply n _ _) = mkUniqueGrimily n
+uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2
+takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)
{-
************************************************************************
diff --git a/compiler/basicTypes/Unique.hs b/compiler/basicTypes/Unique.hs
index 70600d8d11..5ce9c64a0c 100644
--- a/compiler/basicTypes/Unique.hs
+++ b/compiler/basicTypes/Unique.hs
@@ -28,7 +28,7 @@ module Unique (
pprUnique,
mkUniqueGrimily, -- Used in UniqSupply only!
- getKey, getKeyFastInt, -- Used in Var, UniqFM, Name only!
+ getKey, -- Used in Var, UniqFM, Name only!
mkUnique, unpkUnique, -- Used in BinIface only
incrUnique, -- Used for renumbering
@@ -61,16 +61,15 @@ module Unique (
#include "HsVersions.h"
import BasicTypes
-import FastTypes
import FastString
import Outputable
--- import StaticFlags
import Util
---just for implementing a fast [0,61) -> Char function
-import GHC.Exts (indexCharOffAddr#, Char(..))
+-- just for implementing a fast [0,61) -> Char function
+import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
import Data.Char ( chr, ord )
+import Data.Bits
{-
************************************************************************
@@ -88,7 +87,7 @@ Fast comparison is everything on @Uniques@:
-- | The type of unique identifiers that are used in many places in GHC
-- for fast ordering and equality tests. You should generate these with
-- the functions from the 'UniqSupply' module
-data Unique = MkUnique FastInt
+data Unique = MkUnique {-# UNPACK #-} !Int
{-
Now come the functions which construct uniques from their pieces, and vice versa.
@@ -99,24 +98,21 @@ unpkUnique :: Unique -> (Char, Int) -- The reverse
mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply
getKey :: Unique -> Int -- for Var
-getKeyFastInt :: Unique -> FastInt -- for Var
incrUnique :: Unique -> Unique
deriveUnique :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique
-mkUniqueGrimily x = MkUnique (iUnbox x)
+mkUniqueGrimily = MkUnique
{-# INLINE getKey #-}
-getKey (MkUnique x) = iBox x
-{-# INLINE getKeyFastInt #-}
-getKeyFastInt (MkUnique x) = x
+getKey (MkUnique x) = x
-incrUnique (MkUnique i) = MkUnique (i +# _ILIT(1))
+incrUnique (MkUnique i) = MkUnique (i + 1)
-- deriveUnique uses an 'X' tag so that it won't clash with
-- any of the uniques produced any other way
-deriveUnique (MkUnique i) delta = mkUnique 'X' (iBox i + delta)
+deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
@@ -131,17 +127,17 @@ mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
-- NOT EXPORTED, so that we can see all the Chars that
-- are used in this one module
mkUnique c i
- = MkUnique (tag `bitOrFastInt` bits)
+ = MkUnique (tag .|. bits)
where
- !tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
- !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
+ tag = ord c `shiftL` 24
+ bits = i .&. 16777215 {-``0x00ffffff''-}
unpkUnique (MkUnique u)
= let
-- as long as the Char may have its eighth bit set, we
-- really do need the logical right-shift here!
- tag = cBox (fastChr (u `shiftRLFastInt` _ILIT(24)))
- i = iBox (u `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-})
+ tag = chr (u `shiftR` 24)
+ i = u .&. 16777215 {-``0x00ffffff''-}
in
(tag, i)
@@ -161,7 +157,7 @@ hasKey :: Uniquable a => a -> Unique -> Bool
x `hasKey` k = getUnique x == k
instance Uniquable FastString where
- getUnique fs = mkUniqueGrimily (iBox (uniqueOfFS fs))
+ getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
instance Uniquable Int where
getUnique i = mkUniqueGrimily i
@@ -179,13 +175,13 @@ use `deriving' because we want {\em precise} control of ordering
-}
eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
-eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
-ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
-leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
+eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
+ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2
+leUnique (MkUnique u1) (MkUnique u2) = u1 <= u2
cmpUnique :: Unique -> Unique -> Ordering
cmpUnique (MkUnique u1) (MkUnique u2)
- = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
+ = if u1 == u2 then EQ else if u1 < u2 then LT else GT
instance Eq Unique where
a == b = eqUnique a b
@@ -239,20 +235,18 @@ Code stolen from Lennart.
iToBase62 :: Int -> String
iToBase62 n_
- = ASSERT(n_ >= 0) go (iUnbox n_) ""
+ = ASSERT(n_ >= 0) go n_ ""
where
- go n cs | n <# _ILIT(62)
- = case chooseChar62 n of { c -> c `seq` (c : cs) }
- | otherwise
- = case (quotRem (iBox n) 62) of { (q_, r_) ->
- case iUnbox q_ of { q -> case iUnbox r_ of { r ->
- case (chooseChar62 r) of { c -> c `seq`
- (go q (c : cs)) }}}}
-
- chooseChar62 :: FastInt -> Char
+ go n cs | n < 62
+ = let !c = chooseChar62 n in c : cs
+ | otherwise
+ = go q (c : cs) where (q, r) = quotRem n 62
+ !c = chooseChar62 r
+
+ chooseChar62 :: Int -> Char
{-# INLINE chooseChar62 #-}
- chooseChar62 n = C# (indexCharOffAddr# chars62 n)
- !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
+ chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
+ chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
{-
************************************************************************
@@ -345,7 +339,7 @@ mkCostCentreUnique = mkUnique 'C'
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
-- See Note [The Unique of an OccName] in OccName
-mkVarOccUnique fs = mkUnique 'i' (iBox (uniqueOfFS fs))
-mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
-mkTvOccUnique fs = mkUnique 'v' (iBox (uniqueOfFS fs))
-mkTcOccUnique fs = mkUnique 'c' (iBox (uniqueOfFS fs))
+mkVarOccUnique fs = mkUnique 'i' (uniqueOfFS fs)
+mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
+mkTvOccUnique fs = mkUnique 'v' (uniqueOfFS fs)
+mkTcOccUnique fs = mkUnique 'c' (uniqueOfFS fs)
diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs
index 9827450bb8..7c4ccfcdc3 100644
--- a/compiler/basicTypes/Var.hs
+++ b/compiler/basicTypes/Var.hs
@@ -75,7 +75,6 @@ import {-# SOURCE #-} IdInfo( IdDetails, IdInfo, coVarDetails, vanillaIdInfo,
import Name hiding (varName)
import Unique
import Util
-import FastTypes
import FastString
import Outputable
@@ -154,7 +153,8 @@ data Var
= TyVar { -- Type and kind variables
-- see Note [Kind and type variables]
varName :: !Name,
- realUnique :: FastInt, -- Key for fast comparison
+ realUnique :: {-# UNPACK #-} !Int,
+ -- ^ Key for fast comparison
-- Identical to the Unique in the name,
-- cached here for speed
varType :: Kind -- ^ The type or kind of the 'Var' in question
@@ -164,13 +164,13 @@ data Var
-- Used for kind variables during
-- inference, as well
varName :: !Name,
- realUnique :: FastInt,
+ realUnique :: {-# UNPACK #-} !Int,
varType :: Kind,
tc_tv_details :: TcTyVarDetails }
| Id {
varName :: !Name,
- realUnique :: FastInt,
+ realUnique :: {-# UNPACK #-} !Int,
varType :: Type,
idScope :: IdScope,
id_details :: IdDetails, -- Stable, doesn't change
@@ -228,13 +228,13 @@ instance Uniquable Var where
getUnique = varUnique
instance Eq Var where
- a == b = realUnique a ==# realUnique b
+ a == b = realUnique a == realUnique b
instance Ord Var where
- a <= b = realUnique a <=# realUnique b
- a < b = realUnique a <# realUnique b
- a >= b = realUnique a >=# realUnique b
- a > b = realUnique a ># realUnique b
+ a <= b = realUnique a <= realUnique b
+ a < b = realUnique a < realUnique b
+ a >= b = realUnique a >= realUnique b
+ a > b = realUnique a > realUnique b
a `compare` b = varUnique a `compare` varUnique b
instance Data Var where
@@ -244,16 +244,16 @@ instance Data Var where
dataTypeOf _ = mkNoRepType "Var"
varUnique :: Var -> Unique
-varUnique var = mkUniqueGrimily (iBox (realUnique var))
+varUnique var = mkUniqueGrimily (realUnique var)
setVarUnique :: Var -> Unique -> Var
setVarUnique var uniq
- = var { realUnique = getKeyFastInt uniq,
+ = var { realUnique = getKey uniq,
varName = setNameUnique (varName var) uniq }
setVarName :: Var -> Name -> Var
setVarName var new_name
- = var { realUnique = getKeyFastInt (getUnique new_name),
+ = var { realUnique = getKey (getUnique new_name),
varName = new_name }
setVarType :: Id -> Type -> Id
@@ -292,7 +292,7 @@ updateTyVarKindM update tv
mkTyVar :: Name -> Kind -> TyVar
mkTyVar name kind = TyVar { varName = name
- , realUnique = getKeyFastInt (nameUnique name)
+ , realUnique = getKey (nameUnique name)
, varType = kind
}
@@ -300,7 +300,7 @@ mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
mkTcTyVar name kind details
= -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar'
TcTyVar { varName = name,
- realUnique = getKeyFastInt (nameUnique name),
+ realUnique = getKey (nameUnique name),
varType = kind,
tc_tv_details = details
}
@@ -317,7 +317,7 @@ mkKindVar :: Name -> SuperKind -> KindVar
-- to superKind here.
mkKindVar name kind = TyVar
{ varName = name
- , realUnique = getKeyFastInt (nameUnique name)
+ , realUnique = getKey (nameUnique name)
, varType = kind }
{-
@@ -358,7 +358,7 @@ mkExportedLocalVar details name ty info
mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id
mk_id name ty scope details info
= Id { varName = name,
- realUnique = getKeyFastInt (nameUnique name),
+ realUnique = getKey (nameUnique name),
varType = ty,
idScope = scope,
id_details = details,
diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs
index 1d1c0604a3..424edcafe7 100644
--- a/compiler/basicTypes/VarEnv.hs
+++ b/compiler/basicTypes/VarEnv.hs
@@ -56,7 +56,6 @@ import Unique
import Util
import Maybes
import Outputable
-import FastTypes
import StaticFlags
import FastString
@@ -69,7 +68,7 @@ import FastString
-}
-- | A set of variables that are in scope at some point
-data InScopeSet = InScope (VarEnv Var) FastInt
+data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int
-- The (VarEnv Var) is just a VarSet. But we write it like
-- this to remind ourselves that you can look up a Var in
-- the InScopeSet. Typically the InScopeSet contains the
@@ -81,7 +80,7 @@ data InScopeSet = InScope (VarEnv Var) FastInt
-- the case in the past, when we had a grevious hack
-- mapping var1 to var2.
--
- -- The FastInt is a kind of hash-value used by uniqAway
+ -- The Int is a kind of hash-value used by uniqAway
-- For example, it might be the size of the set
-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
@@ -89,25 +88,25 @@ instance Outputable InScopeSet where
ppr (InScope s _) = ptext (sLit "InScope") <+> ppr s
emptyInScopeSet :: InScopeSet
-emptyInScopeSet = InScope emptyVarSet (_ILIT(1))
+emptyInScopeSet = InScope emptyVarSet 1
getInScopeVars :: InScopeSet -> VarEnv Var
getInScopeVars (InScope vs _) = vs
mkInScopeSet :: VarEnv Var -> InScopeSet
-mkInScopeSet in_scope = InScope in_scope (_ILIT(1))
+mkInScopeSet in_scope = InScope in_scope 1
extendInScopeSet :: InScopeSet -> Var -> InScopeSet
-extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# _ILIT(1))
+extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n + 1)
extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
extendInScopeSetList (InScope in_scope n) vs
= InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
- (n +# iUnbox (length vs))
+ (n + length vs)
extendInScopeSetSet :: InScopeSet -> VarEnv Var -> InScopeSet
extendInScopeSetSet (InScope in_scope n) vs
- = InScope (in_scope `plusVarEnv` vs) (n +# iUnbox (sizeUFM vs))
+ = InScope (in_scope `plusVarEnv` vs) (n + sizeUFM vs)
delInScopeSet :: InScopeSet -> Var -> InScopeSet
delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
@@ -141,19 +140,19 @@ uniqAway in_scope var
uniqAway' :: InScopeSet -> Var -> Var
-- This one *always* makes up a new variable
uniqAway' (InScope set n) var
- = try (_ILIT(1))
+ = try 1
where
orig_unique = getUnique var
try k
- | debugIsOn && (k ># _ILIT(1000))
- = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
- | uniq `elemVarSetByKey` set = try (k +# _ILIT(1))
- | debugIsOn && opt_PprStyle_Debug && (k ># _ILIT(3))
- = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n))
+ | debugIsOn && (k > 1000)
+ = pprPanic "uniqAway loop:" (ppr k <+> text "tries" <+> ppr var <+> int n)
+ | uniq `elemVarSetByKey` set = try (k + 1)
+ | debugIsOn && opt_PprStyle_Debug && (k > 3)
+ = pprTrace "uniqAway:" (ppr k <+> text "tries" <+> ppr var <+> int n)
setVarUnique var uniq
| otherwise = setVarUnique var uniq
where
- uniq = deriveUnique orig_unique (iBox (n *# k))
+ uniq = deriveUnique orig_unique (n * k)
{-
************************************************************************
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 84499b97de..7c634c2201 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -21,7 +21,6 @@ import CmmUtils
import Cmm
import DynFlags
-import FastTypes
import Outputable
import Platform
@@ -376,30 +375,19 @@ cmmMachOpFoldM _ _ _ = Nothing
-- This algorithm for determining the $\log_2$ of exact powers of 2 comes
-- from GCC. It requires bit manipulation primitives, and we use GHC
-- extensions. Tough.
---
--- Used to be in MachInstrs --SDM.
--- ToDo: remove use of unboxery --SDM.
-
--- Unboxery removed in favor of FastInt; but is the function supposed to fail
--- on inputs >= 2147483648, or was that just an implementation artifact?
--- And is this speed-critical, or can we just use Integer operations
--- (including Data.Bits)?
--- --Isaac Dupree
exactLog2 :: Integer -> Maybe Integer
-exactLog2 x_
- = if (x_ <= 0 || x_ >= 2147483648) then
+exactLog2 x
+ = if (x <= 0 || x >= 2147483648) then
Nothing
else
- case iUnbox (fromInteger x_) of { x ->
- if (x `bitAndFastInt` negateFastInt x) /=# x then
+ if (x .&. (-x)) /= x then
Nothing
else
- Just (toInteger (iBox (pow2 x)))
- }
+ Just (pow2 x)
where
- pow2 x | x ==# _ILIT(1) = _ILIT(0)
- | otherwise = _ILIT(1) +# pow2 (x `shiftR_FastInt` _ILIT(1))
+ pow2 x | x == 1 = 0
+ | otherwise = 1 + pow2 (x `shiftR` 1)
-- -----------------------------------------------------------------------------
-- Utils
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 91dbed9ecb..b04c13d886 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -59,7 +59,6 @@ import PrelNames
import TysPrim ( realWorldStatePrimTy )
import Bag
import Util
-import FastTypes
import FastString
import Outputable
import ForeignCall
@@ -332,17 +331,17 @@ calcUnfoldingGuidance dflags (Tick t expr)
| not (tickishIsCode t) -- non-code ticks don't matter for unfolding
= calcUnfoldingGuidance dflags expr
calcUnfoldingGuidance dflags expr
- = case sizeExpr dflags (iUnbox bOMB_OUT_SIZE) val_bndrs body of
+ = case sizeExpr dflags bOMB_OUT_SIZE val_bndrs body of
TooBig -> UnfNever
SizeIs size cased_bndrs scrut_discount
- | uncondInline expr n_val_bndrs (iBox size)
+ | uncondInline expr n_val_bndrs size
-> UnfWhen { ug_unsat_ok = unSaturatedOk
, ug_boring_ok = boringCxtOk
, ug_arity = n_val_bndrs } -- Note [INLINE for small functions]
| otherwise
-> UnfIfGoodArgs { ug_args = map (mk_discount cased_bndrs) val_bndrs
- , ug_size = iBox size
- , ug_res = iBox scrut_discount }
+ , ug_size = size
+ , ug_res = scrut_discount }
where
(bndrs, body) = collectBinders expr
@@ -469,7 +468,7 @@ uncondInline rhs arity size
| otherwise = exprIsTrivial rhs -- See Note [INLINE for small functions] (4)
sizeExpr :: DynFlags
- -> FastInt -- Bomb out if it gets bigger than this
+ -> Int -- Bomb out if it gets bigger than this
-> [Id] -- Arguments; we're interested in which of these
-- get case'd
-> CoreExpr
@@ -525,7 +524,7 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
-- the case when we are scrutinising an argument variable
alts_size (SizeIs tot tot_disc tot_scrut) -- Size of all alternatives
(SizeIs max _ _) -- Size of biggest alternative
- = SizeIs tot (unitBag (v, iBox (_ILIT(20) +# tot -# max)) `unionBags` tot_disc) tot_scrut
+ = SizeIs tot (unitBag (v, 20 + tot - max) `unionBags` tot_disc) tot_scrut
-- If the variable is known, we produce a discount that
-- will take us back to 'max', the size of the largest alternative
-- The 1+ is a little discount for reduced allocation in the caller
@@ -605,22 +604,22 @@ sizeExpr dflags bOMB_OUT_SIZE top_args expr
-- These addSize things have to be here because
-- I don't want to give them bOMB_OUT_SIZE as an argument
addSizeN TooBig _ = TooBig
- addSizeN (SizeIs n xs d) m = mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
+ addSizeN (SizeIs n xs d) m = mkSizeIs bOMB_OUT_SIZE (n + m) xs d
-- addAltSize is used to add the sizes of case alternatives
addAltSize TooBig _ = TooBig
addAltSize _ TooBig = TooBig
addAltSize (SizeIs n1 xs d1) (SizeIs n2 ys d2)
- = mkSizeIs bOMB_OUT_SIZE (n1 +# n2)
+ = mkSizeIs bOMB_OUT_SIZE (n1 + n2)
(xs `unionBags` ys)
- (d1 +# d2) -- Note [addAltSize result discounts]
+ (d1 + d2) -- Note [addAltSize result discounts]
-- This variant ignores the result discount from its LEFT argument
-- It's used when the second argument isn't part of the result
addSizeNSD TooBig _ = TooBig
addSizeNSD _ TooBig = TooBig
addSizeNSD (SizeIs n1 xs _) (SizeIs n2 ys d2)
- = mkSizeIs bOMB_OUT_SIZE (n1 +# n2)
+ = mkSizeIs bOMB_OUT_SIZE (n1 + n2)
(xs `unionBags` ys)
d2 -- Ignore d1
@@ -648,7 +647,7 @@ classOpSize :: DynFlags -> [Id] -> [CoreExpr] -> ExprSize
classOpSize _ _ []
= sizeZero
classOpSize dflags top_args (arg1 : other_args)
- = SizeIs (iUnbox size) arg_discount (_ILIT(0))
+ = SizeIs size arg_discount 0
where
size = 20 + (10 * length other_args)
-- If the class op is scrutinising a lambda bound dictionary then
@@ -665,7 +664,7 @@ funSize :: DynFlags -> [Id] -> Id -> Int -> Int -> ExprSize
funSize dflags top_args fun n_val_args voids
| fun `hasKey` buildIdKey = buildSize
| fun `hasKey` augmentIdKey = augmentSize
- | otherwise = SizeIs (iUnbox size) arg_discount (iUnbox res_discount)
+ | otherwise = SizeIs size arg_discount res_discount
where
some_val_args = n_val_args > 0
@@ -689,13 +688,13 @@ funSize dflags top_args fun n_val_args voids
conSize :: DataCon -> Int -> ExprSize
conSize dc n_val_args
- | n_val_args == 0 = SizeIs (_ILIT(0)) emptyBag (_ILIT(10)) -- Like variables
+ | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables
-- See Note [Unboxed tuple size and result discount]
- | isUnboxedTupleCon dc = SizeIs (_ILIT(0)) emptyBag (iUnbox (10 * (1 + n_val_args)))
+ | isUnboxedTupleCon dc = SizeIs 0 emptyBag (10 * (1 + n_val_args))
-- See Note [Constructor size and result discount]
- | otherwise = SizeIs (_ILIT(10)) emptyBag (iUnbox (10 * (1 + n_val_args)))
+ | otherwise = SizeIs 10 emptyBag (10 * (1 + n_val_args))
{-
Note [Constructor size and result discount]
@@ -780,7 +779,7 @@ primOpSize op n_val_args
buildSize :: ExprSize
-buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
+buildSize = SizeIs 0 emptyBag 40
-- We really want to inline applications of build
-- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
-- Indeed, we should add a result_discount becuause build is
@@ -789,13 +788,13 @@ buildSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
-- The "4" is rather arbitrary.
augmentSize :: ExprSize
-augmentSize = SizeIs (_ILIT(0)) emptyBag (_ILIT(40))
+augmentSize = SizeIs 0 emptyBag 40
-- Ditto (augment t (\cn -> e) ys) should cost only the cost of
-- e plus ys. The -2 accounts for the \cn
-- When we return a lambda, give a discount if it's used (applied)
lamScrutDiscount :: DynFlags -> ExprSize -> ExprSize
-lamScrutDiscount dflags (SizeIs n vs _) = SizeIs n vs (iUnbox (ufFunAppDiscount dflags))
+lamScrutDiscount dflags (SizeIs n vs _) = SizeIs n vs (ufFunAppDiscount dflags)
lamScrutDiscount _ TooBig = TooBig
{-
@@ -853,36 +852,41 @@ In a function application (f a b)
Code for manipulating sizes
-}
-data ExprSize = TooBig
- | SizeIs FastInt -- Size found
- !(Bag (Id,Int)) -- Arguments cased herein, and discount for each such
- FastInt -- Size to subtract if result is scrutinised
- -- by a case expression
+-- | The size of an candidate expression for unfolding
+data ExprSize
+ = TooBig
+ | SizeIs { _es_size_is :: {-# UNPACK #-} !Int -- ^ Size found
+ , _es_args :: !(Bag (Id,Int))
+ -- ^ Arguments cased herein, and discount for each such
+ , _es_discount :: {-# UNPACK #-} !Int
+ -- ^ Size to subtract if result is scrutinised by a case
+ -- expression
+ }
instance Outputable ExprSize where
ppr TooBig = ptext (sLit "TooBig")
- ppr (SizeIs a _ c) = brackets (int (iBox a) <+> int (iBox c))
+ ppr (SizeIs a _ c) = brackets (int a <+> int c)
-- subtract the discount before deciding whether to bale out. eg. we
-- want to inline a large constructor application into a selector:
-- tup = (a_1, ..., a_99)
-- x = case tup of ...
--
-mkSizeIs :: FastInt -> FastInt -> Bag (Id, Int) -> FastInt -> ExprSize
-mkSizeIs max n xs d | (n -# d) ># max = TooBig
- | otherwise = SizeIs n xs d
+mkSizeIs :: Int -> Int -> Bag (Id, Int) -> Int -> ExprSize
+mkSizeIs max n xs d | (n - d) > max = TooBig
+ | otherwise = SizeIs n xs d
maxSize :: ExprSize -> ExprSize -> ExprSize
maxSize TooBig _ = TooBig
maxSize _ TooBig = TooBig
-maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2 = s1
+maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 > n2 = s1
| otherwise = s2
sizeZero :: ExprSize
sizeN :: Int -> ExprSize
-sizeZero = SizeIs (_ILIT(0)) emptyBag (_ILIT(0))
-sizeN n = SizeIs (iUnbox n) emptyBag (_ILIT(0))
+sizeZero = SizeIs 0 emptyBag 0
+sizeN n = SizeIs n emptyBag 0
{-
************************************************************************
@@ -899,7 +903,7 @@ actual arguments.
couldBeSmallEnoughToInline :: DynFlags -> Int -> CoreExpr -> Bool
couldBeSmallEnoughToInline dflags threshold rhs
- = case sizeExpr dflags (iUnbox threshold) [] body of
+ = case sizeExpr dflags threshold [] body of
TooBig -> False
_ -> True
where
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 4361c8e244..c8a3893d0f 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -444,7 +444,6 @@ Library
FastFunctions
FastMutInt
FastString
- FastTypes
Fingerprint
FiniteMap
GraphBase
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 817ab8b9c1..69ab85d5da 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -507,7 +507,6 @@ compiler_stage2_dll0_MODULES = \
FastFunctions \
FastMutInt \
FastString \
- FastTypes \
Fingerprint \
FiniteMap \
ForeignCall \
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 8fbe257b83..8b8b9df255 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -654,7 +654,6 @@ ppr_expr (ExplicitTuple exprs boxity)
punc (Missing {} : _) = comma
punc [] = empty
---avoid using PatternSignatures for stage1 code portability
ppr_expr (HsLam matches)
= pprMatches (LambdaExpr :: HsMatchContext id) matches
@@ -986,7 +985,6 @@ ppr_cmd (HsCmdApp c e)
collect_args (L _ (HsCmdApp fun arg)) args = collect_args fun (arg:args)
collect_args fun args = (fun, args)
---avoid using PatternSignatures for stage1 code portability
ppr_cmd (HsCmdLam matches)
= pprMatches (LambdaExpr :: HsMatchContext id) matches
diff --git a/compiler/main/GhcPlugins.hs b/compiler/main/GhcPlugins.hs
index 2b7746c6ce..2326ebdf6c 100644
--- a/compiler/main/GhcPlugins.hs
+++ b/compiler/main/GhcPlugins.hs
@@ -19,7 +19,7 @@ module GhcPlugins(
module VarSet, module VarEnv, module NameSet, module NameEnv,
module UniqSet, module UniqFM, module FiniteMap,
module Util, module Serialized, module SrcLoc, module Outputable,
- module UniqSupply, module Unique, module FastString, module FastTypes
+ module UniqSupply, module Unique, module FastString
) where
-- Plugin stuff itself
@@ -81,4 +81,3 @@ import Outputable
import UniqSupply
import Unique ( Unique, Uniquable(..) )
import FastString
-import FastTypes
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index d0eb183ea7..05efaeb1f4 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -60,7 +60,6 @@ import Unique
import CodeGen.Platform
import DynFlags
import Outputable
-import FastTypes
import Platform
import Data.Word ( Word8, Word16, Word32, Word64 )
@@ -75,44 +74,44 @@ import Data.Int ( Int8, Int16, Int32, Int64 )
-- as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
-virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
+virtualRegSqueeze :: RegClass -> VirtualReg -> Int
virtualRegSqueeze cls vr
= case cls of
RcInteger
-> case vr of
- VirtualRegI{} -> _ILIT(1)
- VirtualRegHi{} -> _ILIT(1)
- _other -> _ILIT(0)
+ VirtualRegI{} -> 1
+ VirtualRegHi{} -> 1
+ _other -> 0
RcDouble
-> case vr of
- VirtualRegD{} -> _ILIT(1)
- VirtualRegF{} -> _ILIT(0)
- _other -> _ILIT(0)
+ VirtualRegD{} -> 1
+ VirtualRegF{} -> 0
+ _other -> 0
- _other -> _ILIT(0)
+ _other -> 0
{-# INLINE realRegSqueeze #-}
-realRegSqueeze :: RegClass -> RealReg -> FastInt
+realRegSqueeze :: RegClass -> RealReg -> Int
realRegSqueeze cls rr
= case cls of
RcInteger
-> case rr of
RealRegSingle regNo
- | regNo < 32 -> _ILIT(1) -- first fp reg is 32
- | otherwise -> _ILIT(0)
+ | regNo < 32 -> 1 -- first fp reg is 32
+ | otherwise -> 0
- RealRegPair{} -> _ILIT(0)
+ RealRegPair{} -> 0
RcDouble
-> case rr of
RealRegSingle regNo
- | regNo < 32 -> _ILIT(0)
- | otherwise -> _ILIT(1)
+ | regNo < 32 -> 0
+ | otherwise -> 1
- RealRegPair{} -> _ILIT(0)
+ RealRegPair{} -> 0
- _other -> _ILIT(0)
+ _other -> 0
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg u format
diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
index b42fb4c39e..be9248f9b6 100644
--- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE CPP #-}
module RegAlloc.Graph.TrivColorable (
trivColorable,
@@ -14,11 +14,9 @@ import Reg
import GraphBase
import UniqFM
-import FastTypes
import Platform
import Panic
-
-- trivColorable ---------------------------------------------------------------
-- trivColorable function for the graph coloring allocator
@@ -55,16 +53,16 @@ import Panic
-- different regSqueeze function for each.
--
accSqueeze
- :: FastInt
- -> FastInt
- -> (reg -> FastInt)
+ :: Int
+ -> Int
+ -> (reg -> Int)
-> UniqFM reg
- -> FastInt
+ -> Int
accSqueeze count maxCount squeeze ufm = acc count (eltsUFM ufm)
where acc count [] = count
- acc count _ | count >=# maxCount = count
- acc count (r:rs) = acc (count +# squeeze r) rs
+ acc count _ | count >= maxCount = count
+ acc count (r:rs) = acc (count + squeeze r) rs
{- Note [accSqueeze]
~~~~~~~~~~~~~~~~~~~~
@@ -100,13 +98,13 @@ the most efficient variant tried. Benchmark compiling 10-times SHA1.hs follows.
trivColorable
:: Platform
- -> (RegClass -> VirtualReg -> FastInt)
- -> (RegClass -> RealReg -> FastInt)
+ -> (RegClass -> VirtualReg -> Int)
+ -> (RegClass -> RealReg -> Int)
-> Triv VirtualReg RegClass RealReg
trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions
- | let !cALLOCATABLE_REGS_INTEGER
- = iUnbox (case platformArch platform of
+ | let cALLOCATABLE_REGS_INTEGER
+ = (case platformArch platform of
ArchX86 -> 3
ArchX86_64 -> 5
ArchPPC -> 16
@@ -119,7 +117,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchJavaScript-> panic "trivColorable ArchJavaScript"
ArchUnknown -> panic "trivColorable ArchUnknown")
- , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_INTEGER
+ , count2 <- accSqueeze 0 cALLOCATABLE_REGS_INTEGER
(virtualRegSqueeze RcInteger)
conflicts
@@ -127,11 +125,11 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl
(realRegSqueeze RcInteger)
exclusions
- = count3 <# cALLOCATABLE_REGS_INTEGER
+ = count3 < cALLOCATABLE_REGS_INTEGER
trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions
- | let !cALLOCATABLE_REGS_FLOAT
- = iUnbox (case platformArch platform of
+ | let cALLOCATABLE_REGS_FLOAT
+ = (case platformArch platform of
ArchX86 -> 0
ArchX86_64 -> 0
ArchPPC -> 0
@@ -144,7 +142,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclus
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchJavaScript-> panic "trivColorable ArchJavaScript"
ArchUnknown -> panic "trivColorable ArchUnknown")
- , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_FLOAT
+ , count2 <- accSqueeze 0 cALLOCATABLE_REGS_FLOAT
(virtualRegSqueeze RcFloat)
conflicts
@@ -152,11 +150,11 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclus
(realRegSqueeze RcFloat)
exclusions
- = count3 <# cALLOCATABLE_REGS_FLOAT
+ = count3 < cALLOCATABLE_REGS_FLOAT
trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions
- | let !cALLOCATABLE_REGS_DOUBLE
- = iUnbox (case platformArch platform of
+ | let cALLOCATABLE_REGS_DOUBLE
+ = (case platformArch platform of
ArchX86 -> 6
ArchX86_64 -> 0
ArchPPC -> 26
@@ -169,7 +167,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchJavaScript-> panic "trivColorable ArchJavaScript"
ArchUnknown -> panic "trivColorable ArchUnknown")
- , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_DOUBLE
+ , count2 <- accSqueeze 0 cALLOCATABLE_REGS_DOUBLE
(virtualRegSqueeze RcDouble)
conflicts
@@ -177,11 +175,11 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu
(realRegSqueeze RcDouble)
exclusions
- = count3 <# cALLOCATABLE_REGS_DOUBLE
+ = count3 < cALLOCATABLE_REGS_DOUBLE
trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions
- | let !cALLOCATABLE_REGS_SSE
- = iUnbox (case platformArch platform of
+ | let cALLOCATABLE_REGS_SSE
+ = (case platformArch platform of
ArchX86 -> 8
ArchX86_64 -> 10
ArchPPC -> 0
@@ -194,7 +192,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts ex
ArchMipsel -> panic "trivColorable ArchMipsel"
ArchJavaScript-> panic "trivColorable ArchJavaScript"
ArchUnknown -> panic "trivColorable ArchUnknown")
- , count2 <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_SSE
+ , count2 <- accSqueeze 0 cALLOCATABLE_REGS_SSE
(virtualRegSqueeze RcDoubleSSE)
conflicts
@@ -202,7 +200,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts ex
(realRegSqueeze RcDoubleSSE)
exclusions
- = count3 <# cALLOCATABLE_REGS_SSE
+ = count3 < cALLOCATABLE_REGS_SSE
-- Specification Code ----------------------------------------------------------
diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs
index 4ae114b0ef..14a5192c2d 100644
--- a/compiler/nativeGen/SPARC/Regs.hs
+++ b/compiler/nativeGen/SPARC/Regs.hs
@@ -39,7 +39,6 @@ import Format
import Unique
import Outputable
-import FastTypes
{-
The SPARC has 64 registers of interest; 32 integer registers and 32
@@ -81,60 +80,60 @@ classOfRealReg reg
-- as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
-virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
+virtualRegSqueeze :: RegClass -> VirtualReg -> Int
virtualRegSqueeze cls vr
= case cls of
RcInteger
-> case vr of
- VirtualRegI{} -> _ILIT(1)
- VirtualRegHi{} -> _ILIT(1)
- _other -> _ILIT(0)
+ VirtualRegI{} -> 1
+ VirtualRegHi{} -> 1
+ _other -> 0
RcFloat
-> case vr of
- VirtualRegF{} -> _ILIT(1)
- VirtualRegD{} -> _ILIT(2)
- _other -> _ILIT(0)
+ VirtualRegF{} -> 1
+ VirtualRegD{} -> 2
+ _other -> 0
RcDouble
-> case vr of
- VirtualRegF{} -> _ILIT(1)
- VirtualRegD{} -> _ILIT(1)
- _other -> _ILIT(0)
+ VirtualRegF{} -> 1
+ VirtualRegD{} -> 1
+ _other -> 0
- _other -> _ILIT(0)
+ _other -> 0
{-# INLINE realRegSqueeze #-}
-realRegSqueeze :: RegClass -> RealReg -> FastInt
+realRegSqueeze :: RegClass -> RealReg -> Int
realRegSqueeze cls rr
= case cls of
RcInteger
-> case rr of
RealRegSingle regNo
- | regNo < 32 -> _ILIT(1)
- | otherwise -> _ILIT(0)
+ | regNo < 32 -> 1
+ | otherwise -> 0
- RealRegPair{} -> _ILIT(0)
+ RealRegPair{} -> 0
RcFloat
-> case rr of
RealRegSingle regNo
- | regNo < 32 -> _ILIT(0)
- | otherwise -> _ILIT(1)
+ | regNo < 32 -> 0
+ | otherwise -> 1
- RealRegPair{} -> _ILIT(2)
+ RealRegPair{} -> 2
RcDouble
-> case rr of
RealRegSingle regNo
- | regNo < 32 -> _ILIT(0)
- | otherwise -> _ILIT(1)
+ | regNo < 32 -> 0
+ | otherwise -> 1
- RealRegPair{} -> _ILIT(1)
+ RealRegPair{} -> 1
- _other -> _ILIT(0)
+ _other -> 0
-- | All the allocatable registers in the machine,
-- including register pairs.
diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs
index 606e6f5d9e..9bd470b0d6 100644
--- a/compiler/nativeGen/TargetReg.hs
+++ b/compiler/nativeGen/TargetReg.hs
@@ -27,7 +27,6 @@ import Format
import Outputable
import Unique
-import FastTypes
import Platform
import qualified X86.Regs as X86
@@ -37,7 +36,7 @@ import qualified PPC.Regs as PPC
import qualified SPARC.Regs as SPARC
-targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> FastInt
+targetVirtualRegSqueeze :: Platform -> RegClass -> VirtualReg -> Int
targetVirtualRegSqueeze platform
= case platformArch platform of
ArchX86 -> X86.virtualRegSqueeze
@@ -54,7 +53,7 @@ targetVirtualRegSqueeze platform
ArchUnknown -> panic "targetVirtualRegSqueeze ArchUnknown"
-targetRealRegSqueeze :: Platform -> RegClass -> RealReg -> FastInt
+targetRealRegSqueeze :: Platform -> RegClass -> RealReg -> Int
targetRealRegSqueeze platform
= case platformArch platform of
ArchX86 -> X86.realRegSqueeze
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
index 5c484743ca..4cb82ea224 100644
--- a/compiler/nativeGen/X86/Regs.hs
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -57,8 +57,6 @@ import CLabel ( CLabel )
import DynFlags
import Outputable
import Platform
-import FastTypes
-
-- | regSqueeze_class reg
-- Calculuate the maximum number of register colors that could be
@@ -66,55 +64,55 @@ import FastTypes
-- as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
-virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
+virtualRegSqueeze :: RegClass -> VirtualReg -> Int
virtualRegSqueeze cls vr
= case cls of
RcInteger
-> case vr of
- VirtualRegI{} -> _ILIT(1)
- VirtualRegHi{} -> _ILIT(1)
- _other -> _ILIT(0)
+ VirtualRegI{} -> 1
+ VirtualRegHi{} -> 1
+ _other -> 0
RcDouble
-> case vr of
- VirtualRegD{} -> _ILIT(1)
- VirtualRegF{} -> _ILIT(0)
- _other -> _ILIT(0)
+ VirtualRegD{} -> 1
+ VirtualRegF{} -> 0
+ _other -> 0
RcDoubleSSE
-> case vr of
- VirtualRegSSE{} -> _ILIT(1)
- _other -> _ILIT(0)
+ VirtualRegSSE{} -> 1
+ _other -> 0
- _other -> _ILIT(0)
+ _other -> 0
{-# INLINE realRegSqueeze #-}
-realRegSqueeze :: RegClass -> RealReg -> FastInt
+realRegSqueeze :: RegClass -> RealReg -> Int
realRegSqueeze cls rr
= case cls of
RcInteger
-> case rr of
RealRegSingle regNo
- | regNo < firstfake -> _ILIT(1)
- | otherwise -> _ILIT(0)
+ | regNo < firstfake -> 1
+ | otherwise -> 0
- RealRegPair{} -> _ILIT(0)
+ RealRegPair{} -> 0
RcDouble
-> case rr of
RealRegSingle regNo
- | regNo >= firstfake && regNo <= lastfake -> _ILIT(1)
- | otherwise -> _ILIT(0)
+ | regNo >= firstfake && regNo <= lastfake -> 1
+ | otherwise -> 0
- RealRegPair{} -> _ILIT(0)
+ RealRegPair{} -> 0
RcDoubleSSE
-> case rr of
- RealRegSingle regNo | regNo >= firstxmm -> _ILIT(1)
- _otherwise -> _ILIT(0)
+ RealRegSingle regNo | regNo >= firstxmm -> 1
+ _otherwise -> 0
- _other -> _ILIT(0)
+ _other -> 0
-- -----------------------------------------------------------------------------
-- Immediates
diff --git a/compiler/prelude/PrimOp.hs b/compiler/prelude/PrimOp.hs
index dbeade27bc..6b012ee5ea 100644
--- a/compiler/prelude/PrimOp.hs
+++ b/compiler/prelude/PrimOp.hs
@@ -38,7 +38,6 @@ import BasicTypes ( Arity, Fixity(..), FixityDirection(..), Boxity(..) )
import ForeignCall ( CLabelString )
import Unique ( Unique, mkPrimOpIdUnique )
import Outputable
-import FastTypes
import FastString
import Module ( PackageKey )
@@ -56,25 +55,20 @@ These are in \tr{state-interface.verb} order.
-- data PrimOp = ...
#include "primop-data-decl.hs-incl"
--- Used for the Ord instance
-
-primOpTag :: PrimOp -> Int
-primOpTag op = iBox (tagOf_PrimOp op)
-
-- supplies
--- tagOf_PrimOp :: PrimOp -> FastInt
+-- primOpTag :: PrimOp -> Int
#include "primop-tag.hs-incl"
-tagOf_PrimOp _ = error "tagOf_PrimOp: unknown primop"
+primOpTag _ = error "primOpTag: unknown primop"
instance Eq PrimOp where
- op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
+ op1 == op2 = primOpTag op1 == primOpTag op2
instance Ord PrimOp where
- op1 < op2 = tagOf_PrimOp op1 <# tagOf_PrimOp op2
- op1 <= op2 = tagOf_PrimOp op1 <=# tagOf_PrimOp op2
- op1 >= op2 = tagOf_PrimOp op1 >=# tagOf_PrimOp op2
- op1 > op2 = tagOf_PrimOp op1 ># tagOf_PrimOp op2
+ op1 < op2 = primOpTag op1 < primOpTag op2
+ op1 <= op2 = primOpTag op1 <= primOpTag op2
+ op1 >= op2 = primOpTag op1 >= primOpTag op2
+ op1 > op2 = primOpTag op1 > primOpTag op2
op1 `compare` op2 | op1 < op2 = LT
| op1 == op2 = EQ
| otherwise = GT
diff --git a/compiler/profiling/CostCentre.hs b/compiler/profiling/CostCentre.hs
index cce8394565..f3bbd50e26 100644
--- a/compiler/profiling/CostCentre.hs
+++ b/compiler/profiling/CostCentre.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
module CostCentre (
CostCentre(..), CcName, IsCafCC(..),
-- All abstract except to friend: ParseIface.y
@@ -26,7 +26,6 @@ import Name
import Module
import Unique
import Outputable
-import FastTypes
import SrcLoc
import FastString
import Util
@@ -87,13 +86,14 @@ cmpCostCentre NormalCC {cc_key = n1, cc_mod = m1}
cmpCostCentre other_1 other_2
= let
- !tag1 = tag_CC other_1
- !tag2 = tag_CC other_2
+ tag1 = tag_CC other_1
+ tag2 = tag_CC other_2
in
- if tag1 <# tag2 then LT else GT
+ if tag1 < tag2 then LT else GT
where
- tag_CC (NormalCC {}) = _ILIT(0)
- tag_CC (AllCafsCC {}) = _ILIT(1)
+ tag_CC :: CostCentre -> Int
+ tag_CC (NormalCC {}) = 0
+ tag_CC (AllCafsCC {}) = 1
-----------------------------------------------------------------------------
diff --git a/compiler/utils/FastFunctions.hs b/compiler/utils/FastFunctions.hs
index 140e42949a..c643e3c8fb 100644
--- a/compiler/utils/FastFunctions.hs
+++ b/compiler/utils/FastFunctions.hs
@@ -1,46 +1,19 @@
{-
-Z%
(c) The University of Glasgow, 2000-2006
-
-\section{Fast functions}
-}
{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
module FastFunctions (
- unsafeChr, inlinePerformIO, unsafeDupableInterleaveIO,
- indexWord8OffFastPtr,
- indexWord8OffFastPtrAsFastChar, indexWord8OffFastPtrAsFastInt,
- global, Global
+ inlinePerformIO,
) where
#include "HsVersions.h"
-import FastTypes
-import Data.IORef
-import System.IO.Unsafe
-
import GHC.Exts
-import GHC.Word
-import GHC.Base (unsafeChr)
-
-import GHC.IO (IO(..), unsafeDupableInterleaveIO)
+import GHC.IO (IO(..))
-- Just like unsafePerformIO, but we inline it.
{-# INLINE inlinePerformIO #-}
inlinePerformIO :: IO a -> a
inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
-
-indexWord8OffFastPtr p i = W8# (indexWord8OffAddr# p i)
-indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
-indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
--- or ord# (indexCharOffAddr# p i)
-
---just so we can refer to the type clearly in a macro
-type Global a = IORef a
-global :: a -> Global a
-global a = unsafePerformIO (newIORef a)
-
-indexWord8OffFastPtr :: FastPtr Word8 -> FastInt -> Word8
-indexWord8OffFastPtrAsFastChar :: FastPtr Word8 -> FastInt -> FastChar
-indexWord8OffFastPtrAsFastInt :: FastPtr Word8 -> FastInt -> FastInt
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index 40c3882b87..32482ccb0b 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -93,7 +93,6 @@ module FastString
#include "HsVersions.h"
import Encoding
-import FastTypes
import FastFunctions
import Panic
import Util
@@ -531,8 +530,8 @@ tailFS (FastString _ _ bs _) =
consFS :: Char -> FastString -> FastString
consFS c fs = mkFastString (c : unpackFS fs)
-uniqueOfFS :: FastString -> FastInt
-uniqueOfFS (FastString u _ _ _) = iUnbox u
+uniqueOfFS :: FastString -> Int
+uniqueOfFS (FastString u _ _ _) = u
nilFS :: FastString
nilFS = mkFastString ""
@@ -561,23 +560,14 @@ hPutFS handle fs = BS.hPut handle $ fastStringToByteString fs
-- -----------------------------------------------------------------------------
-- LitStrings, here for convenience only.
--- hmm, not unboxed (or rather FastPtr), interesting
---a.k.a. Ptr CChar, Ptr Word8, Ptr (), hmph. We don't
---really care about C types in naming, where we can help it.
type LitString = Ptr Word8
--Why do we recalculate length every time it's requested?
--If it's commonly needed, we should perhaps have
---data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
+--data LitString = LitString {-#UNPACK#-}!Addr# {-#UNPACK#-}!Int#
mkLitString# :: Addr# -> LitString
mkLitString# a# = Ptr a#
---can/should we use FastTypes here?
---Is this likely to be memory-preserving if only used on constant strings?
---should we inline it? If lucky, that would make a CAF that wouldn't
---be computationally repeated... although admittedly we're not
---really intending to use mkLitString when __GLASGOW_HASKELL__...
---(I wonder, is unicode / multi-byte characters allowed in LitStrings
--- at all?)
+
{-# INLINE mkLitString #-}
mkLitString :: String -> LitString
mkLitString s =
@@ -594,32 +584,11 @@ mkLitString s =
)
unpackLitString :: LitString -> String
-unpackLitString p_ = case pUnbox p_ of
- p -> unpack (_ILIT(0))
- where
- unpack n = case indexWord8OffFastPtrAsFastChar p n of
- ch -> if ch `eqFastChar` _CLIT('\0')
- then [] else cBox ch : unpack (n +# _ILIT(1))
+unpackLitString (Ptr p) = unpackCString# p
lengthLS :: LitString -> Int
lengthLS = ptrStrLength
--- for now, use a simple String representation
---no, let's not do that right now - it's work in other places
-#if 0
-type LitString = String
-
-mkLitString :: String -> LitString
-mkLitString = id
-
-unpackLitString :: LitString -> String
-unpackLitString = id
-
-lengthLS :: LitString -> Int
-lengthLS = length
-
-#endif
-
-- -----------------------------------------------------------------------------
-- under the carpet
diff --git a/compiler/utils/FastTypes.hs b/compiler/utils/FastTypes.hs
deleted file mode 100644
index a5c1aa9637..0000000000
--- a/compiler/utils/FastTypes.hs
+++ /dev/null
@@ -1,138 +0,0 @@
-{-
-(c) The University of Glasgow, 2000-2006
-
-\section{Fast integers, etc... booleans moved to FastBool for using panic}
--}
-
-{-# LANGUAGE CPP, MagicHash #-}
-
---Even if the optimizer could handle boxed arithmetic equally well,
---this helps automatically check the sources to make sure that
---it's only used in an appropriate pattern of efficiency.
---(it also makes `let`s and `case`s stricter...)
-
--- | Fast integers, characters and pointer types for use in many parts of GHC
-module FastTypes (
- -- * FastInt
- FastInt,
-
- -- ** Getting in and out of FastInt
- _ILIT, iBox, iUnbox,
-
- -- ** Arithmetic on FastInt
- (+#), (-#), (*#), quotFastInt, negateFastInt,
- --quotRemFastInt is difficult because unboxed values can't
- --be tupled, but unboxed tuples aren't portable. Just use
- -- nuisance boxed quotRem and rely on optimization.
- (==#), (/=#), (<#), (<=#), (>=#), (>#),
- minFastInt, maxFastInt,
- --prefer to distinguish operations, not types, between
- --signed and unsigned.
- --left-shift is the same for 'signed' and 'unsigned' numbers
- shiftLFastInt,
- --right-shift isn't the same for negative numbers (ones with
- --the highest-order bit '1'). If you don't care because the
- --number you're shifting is always nonnegative, use the '_' version
- --which should just be the fastest one.
- shiftR_FastInt,
- --"L' = logical or unsigned shift; 'A' = arithmetic or signed shift
- shiftRLFastInt, shiftRAFastInt,
- bitAndFastInt, bitOrFastInt,
- --add more operations to this file as you need them
-
- -- * FastChar
- FastChar,
-
- -- ** Getting in and out of FastChar
- _CLIT, cBox, cUnbox,
-
- -- ** Operations on FastChar
- fastOrd, fastChr, eqFastChar,
- --note, fastChr is "unsafe"Chr: it doesn't check for
- --character values above the range of Unicode
-
- -- * FastPtr
- FastPtr,
-
- -- ** Getting in and out of FastPtr
- pBox, pUnbox,
-
- -- ** Casting FastPtrs
- castFastPtr
- ) where
-
-#include "HsVersions.h"
-
--- Import the beggars
-import ExtsCompat46
-
-type FastInt = Int#
-
---in case it's a macro, don't lexically feed an argument!
---e.g. #define _ILIT(x) (x#) , #define _ILIT(x) (x :: FastInt)
-_ILIT = \(I# x) -> x
---perhaps for accomodating caseless-leading-underscore treatment,
---something like _iLIT or iLIT would be better?
-
-iBox x = I# x
-iUnbox (I# x) = x
-quotFastInt = quotInt#
-negateFastInt = negateInt#
-
---I think uncheckedIShiftL# and uncheckedIShiftRL# are the same
---as uncheckedShiftL# and uncheckedShiftRL# ...
---should they be used? How new are they?
---They existed as far back as GHC 6.0 at least...
-shiftLFastInt x y = uncheckedIShiftL# x y
-shiftR_FastInt x y = uncheckedIShiftRL# x y
-shiftRLFastInt x y = uncheckedIShiftRL# x y
-shiftRAFastInt x y = uncheckedIShiftRA# x y
---{-# INLINE shiftLNonnegativeFastInt #-}
---{-# INLINE shiftRNonnegativeFastInt #-}
---shiftLNonnegativeFastInt n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
---shiftRNonnegativeFastInt n p = word2Int#((int2Word# n) `uncheckedShiftRL#` p)
-bitAndFastInt x y = word2Int# (and# (int2Word# x) (int2Word# y))
-bitOrFastInt x y = word2Int# (or# (int2Word# x) (int2Word# y))
-
-type FastChar = Char#
-_CLIT = \(C# c) -> c
-cBox c = C# c
-cUnbox (C# c) = c
-fastOrd c = ord# c
-fastChr x = chr# x
-eqFastChar a b = eqChar# a b
-
---note that the type-parameter doesn't provide any safety
---when it's a synonym, but as long as we keep it compiling
---with and without __GLASGOW_HASKELL__ defined, it's fine.
-type FastPtr a = Addr#
-pBox p = Ptr p
-pUnbox (Ptr p) = p
-castFastPtr p = p
-
-minFastInt, maxFastInt :: FastInt -> FastInt -> FastInt
-minFastInt x y = if x <# y then x else y
-maxFastInt x y = if x <# y then y else x
-
--- type-signatures will improve the non-ghc-specific versions
--- and keep things accurate (and ABLE to compile!)
-_ILIT :: Int -> FastInt
-iBox :: FastInt -> Int
-iUnbox :: Int -> FastInt
-
-quotFastInt :: FastInt -> FastInt -> FastInt
-negateFastInt :: FastInt -> FastInt
-shiftLFastInt, shiftR_FastInt, shiftRAFastInt, shiftRLFastInt
- :: FastInt -> FastInt -> FastInt
-bitAndFastInt, bitOrFastInt :: FastInt -> FastInt -> FastInt
-
-_CLIT :: Char -> FastChar
-cBox :: FastChar -> Char
-cUnbox :: Char -> FastChar
-fastOrd :: FastChar -> FastInt
-fastChr :: FastInt -> FastChar
-eqFastChar :: FastChar -> FastChar -> Bool
-
-pBox :: FastPtr a -> Ptr a
-pUnbox :: Ptr a -> FastPtr a
-castFastPtr :: FastPtr a -> FastPtr b
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index 948ae7d5df..93645d38fe 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -72,9 +72,9 @@ module Outputable (
mkUserStyle, cmdlineParserStyle, Depth(..),
-- * Error handling and debugging utilities
- pprPanic, pprSorry, assertPprPanic, pprPanicFastInt, pprPgmError,
+ pprPanic, pprSorry, assertPprPanic, pprPgmError,
pprTrace, warnPprTrace,
- trace, pgmError, panic, sorry, panicFastInt, assertPanic,
+ trace, pgmError, panic, sorry, assertPanic,
pprDebugAndThen,
) where
@@ -87,7 +87,6 @@ import {-# SOURCE #-} OccName( OccName )
import {-# SOURCE #-} StaticFlags( opt_PprStyle_Debug, opt_NoDebugOutput )
import FastString
-import FastTypes
import qualified Pretty
import Util
import Platform
@@ -1032,10 +1031,6 @@ pprTrace str doc x
| opt_NoDebugOutput = x
| otherwise = pprDebugAndThen unsafeGlobalDynFlags trace (text str) doc x
-pprPanicFastInt :: String -> SDoc -> FastInt
--- ^ Specialization of pprPanic that can be safely used with 'FastInt'
-pprPanicFastInt heading pretty_msg = panicDocFastInt heading pretty_msg
-
warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
-- ^ Just warn about an assertion failure, recording the given file and line number.
-- Should typically be accessed with the WARN macros
diff --git a/compiler/utils/Panic.hs b/compiler/utils/Panic.hs
index bfb9df3ad3..e1c848d540 100644
--- a/compiler/utils/Panic.hs
+++ b/compiler/utils/Panic.hs
@@ -17,8 +17,8 @@ module Panic (
progName,
pgmError,
- panic, sorry, panicFastInt, assertPanic, trace,
- panicDoc, sorryDoc, panicDocFastInt, pgmErrorDoc,
+ panic, sorry, assertPanic, trace,
+ panicDoc, sorryDoc, pgmErrorDoc,
Exception.Exception(..), showException, safeShowException, try, tryMost, throwTo,
@@ -30,7 +30,6 @@ module Panic (
import {-# SOURCE #-} Outputable (SDoc)
import Config
-import FastTypes
import Exception
import Control.Concurrent
@@ -198,16 +197,6 @@ sorryDoc x doc = throwGhcException (PprSorry x doc)
pgmErrorDoc x doc = throwGhcException (PprProgramError x doc)
--- | Panic while pretending to return an unboxed int.
--- You can't use the regular panic functions in expressions
--- producing unboxed ints because they have the wrong kind.
-panicFastInt :: String -> FastInt
-panicFastInt s = case (panic s) of () -> _ILIT(0)
-
-panicDocFastInt :: String -> SDoc -> FastInt
-panicDocFastInt s d = case (panicDoc s d) of () -> _ILIT(0)
-
-
-- | Throw an failed assertion exception for a given filename and line number.
assertPanic :: String -> Int -> a
assertPanic file line =
diff --git a/compiler/utils/StringBuffer.hs b/compiler/utils/StringBuffer.hs
index 570282da57..2e339d8d75 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/utils/StringBuffer.hs
@@ -6,8 +6,8 @@
Buffers for scanning string input stored in external arrays.
-}
-{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
-{-# OPTIONS_GHC -O -funbox-strict-fields #-}
+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_GHC -O #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
@@ -45,7 +45,6 @@ module StringBuffer
import Encoding
import FastString
-import FastTypes
import FastFunctions
import Outputable
import Util
@@ -232,26 +231,10 @@ lexemeToFastString (StringBuffer buf _ cur) len =
-- -----------------------------------------------------------------------------
-- Parsing integer strings in various bases
-{-
-byteOff :: StringBuffer -> Int -> Char
-byteOff (StringBuffer buf _ cur) i =
- inlinePerformIO $ withForeignPtr buf $ \ptr -> do
--- return $! cBox (indexWord8OffFastPtrAsFastChar
--- (pUnbox ptr) (iUnbox (cur+i)))
---or
--- w <- peek (ptr `plusPtr` (cur+i))
--- return (unsafeChr (fromIntegral (w::Word8)))
--}
--- | XXX assumes ASCII digits only (by using byteOff)
parseUnsignedInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
parseUnsignedInteger (StringBuffer buf _ cur) len radix char_to_int
= inlinePerformIO $ withForeignPtr buf $ \ptr -> return $! let
- --LOL, in implementations where the indexing needs slow unsafePerformIO,
- --this is less (not more) efficient than using the IO monad explicitly
- --here.
- !ptr' = pUnbox ptr
- byteOff i = cBox (indexWord8OffFastPtrAsFastChar ptr' (iUnbox (cur + i)))
go i x | i == len = x
- | otherwise = case byteOff i of
+ | otherwise = case fst (utf8DecodeChar (ptr `plusPtr` (cur + i))) of
char -> go (i + 1) (x * radix + toInteger (char_to_int char))
in go 0 0
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 96e911ee44..e9b9d3f3df 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -114,9 +114,7 @@ import Data.IORef ( IORef, newIORef, atomicModifyIORef' )
import System.IO.Unsafe ( unsafePerformIO )
import Data.List hiding (group)
-#ifdef DEBUG
-import FastTypes
-#endif
+import GHC.Exts
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative (Applicative)
@@ -465,22 +463,22 @@ isn'tIn _msg x ys = x `notElem` ys
# else /* DEBUG */
isIn msg x ys
- = elem100 (_ILIT(0)) x ys
+ = elem100 0 x ys
where
- elem100 _ _ [] = False
+ elem100 :: Eq a => Int -> a -> [a] -> Bool
+ elem100 _ _ [] = False
elem100 i x (y:ys)
- | i ># _ILIT(100) = trace ("Over-long elem in " ++ msg)
- (x `elem` (y:ys))
- | otherwise = x == y || elem100 (i +# _ILIT(1)) x ys
+ | i > 100 = trace ("Over-long elem in " ++ msg) (x `elem` (y:ys))
+ | otherwise = x == y || elem100 (i + 1) x ys
isn'tIn msg x ys
- = notElem100 (_ILIT(0)) x ys
+ = notElem100 0 x ys
where
+ notElem100 :: Eq a => Int -> a -> [a] -> Bool
notElem100 _ _ [] = True
notElem100 i x (y:ys)
- | i ># _ILIT(100) = trace ("Over-long notElem in " ++ msg)
- (x `notElem` (y:ys))
- | otherwise = x /= y && notElem100 (i +# _ILIT(1)) x ys
+ | i > 100 = trace ("Over-long notElem in " ++ msg) (x `notElem` (y:ys))
+ | otherwise = x /= y && notElem100 (i + 1) x ys
# endif /* DEBUG */
{-
@@ -491,9 +489,6 @@ isn'tIn msg x ys
************************************************************************
-}
-sortWith :: Ord b => (a->b) -> [a] -> [a]
-sortWith get_key xs = sortBy (comparing get_key) xs
-
minWith :: Ord b => (a -> b) -> [a] -> a
minWith get_key xs = ASSERT( not (null xs) )
head (sortWith get_key xs)
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index d8d555cdf2..2a5218e678 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -688,8 +688,8 @@ gen_primop_tag (Info _ entries)
tagOf_type : zipWith f primop_entries [1 :: Int ..])
where
primop_entries = concatMap desugarVectorSpec $ filter is_primop entries
- tagOf_type = "tagOf_PrimOp :: PrimOp -> FastInt"
- f i n = "tagOf_PrimOp " ++ cons i ++ " = _ILIT(" ++ show n ++ ")"
+ tagOf_type = "primOpTag :: PrimOp -> Int"
+ f i n = "primOpTag " ++ cons i ++ " = " ++ show n
max_def_type = "maxPrimOpTag :: Int"
max_def = "maxPrimOpTag = " ++ show (length primop_entries)