summaryrefslogtreecommitdiff
path: root/compiler/utils
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/utils')
-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
7 files changed, 24 insertions, 258 deletions
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)
View Lorry Controller Status