Refactor: delete most of the module FastTypes
authorThomas Miedema <thomasmiedema@gmail.com>
Fri, 21 Aug 2015 08:44:54 +0000 (10:44 +0200)
committerBen Gamari <ben@smart-cactus.org>
Fri, 21 Aug 2015 13:44:21 +0000 (15:44 +0200)
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

27 files changed:
compiler/basicTypes/Literal.hs
compiler/basicTypes/Name.hs
compiler/basicTypes/UniqSupply.hs
compiler/basicTypes/Unique.hs
compiler/basicTypes/Var.hs
compiler/basicTypes/VarEnv.hs
compiler/cmm/CmmOpt.hs
compiler/coreSyn/CoreUnfold.hs
compiler/ghc.cabal.in
compiler/ghc.mk
compiler/hsSyn/HsExpr.hs
compiler/main/GhcPlugins.hs
compiler/nativeGen/PPC/Regs.hs
compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs
compiler/nativeGen/SPARC/Regs.hs
compiler/nativeGen/TargetReg.hs
compiler/nativeGen/X86/Regs.hs
compiler/prelude/PrimOp.hs
compiler/profiling/CostCentre.hs
compiler/utils/FastFunctions.hs
compiler/utils/FastString.hs
compiler/utils/FastTypes.hs [deleted file]
compiler/utils/Outputable.hs
compiler/utils/Panic.hs
compiler/utils/StringBuffer.hs
compiler/utils/Util.hs
utils/genprimopcode/Main.hs

index ced05a4..5f3b75d 100644 (file)
@@ -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
index 506b60f..79f14ab 100644 (file)
@@ -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
index 3d0573d..67248db 100644 (file)
@@ -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)
 
 {-
 ************************************************************************
index 70600d8..5ce9c64 100644 (file)
@@ -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)
index 9827450..7c4ccfc 100644 (file)
@@ -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,
index 1d1c060..424edca 100644 (file)
@@ -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)
 
 {-
 ************************************************************************
index 84499b9..7c634c2 100644 (file)
@@ -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
index 91dbed9..b04c13d 100644 (file)
@@ -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
index 4361c8e..c8a3893 100644 (file)
@@ -444,7 +444,6 @@ Library
         FastFunctions
         FastMutInt
         FastString
-        FastTypes
         Fingerprint
         FiniteMap
         GraphBase
index 817ab8b..69ab85d 100644 (file)
@@ -507,7 +507,6 @@ compiler_stage2_dll0_MODULES = \
        FastFunctions \
        FastMutInt \
        FastString \
-       FastTypes \
        Fingerprint \
        FiniteMap \
        ForeignCall \
index 8fbe257..8b8b9df 100644 (file)
@@ -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
 
index 2b7746c..2326ebd 100644 (file)
@@ -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
index d0eb183..05efaeb 100644 (file)
@@ -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
index b42fb4c..be9248f 100644 (file)
@@ -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 ----------------------------------------------------------
index 4ae114b..14a5192 100644 (file)
@@ -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.
index 606e6f5..9bd470b 100644 (file)
@@ -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
index 5c48474..4cb82ea 100644 (file)
@@ -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
index dbeade2..6b012ee 100644 (file)
@@ -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
index cce8394..f3bbd50 100644 (file)
@@ -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
 
 
 -----------------------------------------------------------------------------
index 140e429..c643e3c 100644 (file)
@@ -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
index 40c3882..32482cc 100644 (file)
@@ -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 (file)
index a5c1aa9..0000000
+++ /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
index 948ae7d..93645d3 100644 (file)
@@ -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
index bfb9df3..e1c848d 100644 (file)
@@ -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 =
index 570282d..2e339d8 100644 (file)
@@ -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
index 96e911e..e9b9d3f 100644 (file)
@@ -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)
index d8d555c..2a5218e 100644 (file)
@@ -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)