Commit 330bb3ef authored by thomie's avatar thomie Committed by Austin Seipp

Delete all /* ! __GLASGOW_HASKELL__ */ code

Summary:
```
git grep -l '\(#ifdef \|#if defined\)(\?__GLASGOW_HASKELL__)\?'
```

Test Plan: validate

Reviewers: rwbarton, hvr, austin

Reviewed By: rwbarton, hvr, austin

Subscribers: rwbarton, simonmar, ezyang, carter

Differential Revision: https://phabricator.haskell.org/D218
parent 2a743bbd
......@@ -22,9 +22,6 @@ you will screw up the layout where they are used in case expressions!
* settings for the target plat instead). */
#include "../includes/ghcautoconf.h"
/* Global variables may not work in other Haskell implementations,
* but we need them currently! so the conditional on GLASGOW won't do. */
#if defined(__GLASGOW_HASKELL__) || !defined(__GLASGOW_HASKELL__)
#define GLOBAL_VAR(name,value,ty) \
{-# NOINLINE name #-}; \
name :: IORef (ty); \
......@@ -34,14 +31,13 @@ name = Util.global (value);
{-# NOINLINE name #-}; \
name :: IORef (ty); \
name = Util.globalM (value);
#endif
#define ASSERT(e) if debugIsOn && not (e) then (assertPanic __FILE__ __LINE__) else
#define ASSERT2(e,msg) if debugIsOn && not (e) then (assertPprPanic __FILE__ __LINE__ (msg)) else
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg)) $
-- Examples: Assuming flagSet :: String -> m Bool
--
--
-- do { c <- getChar; MASSERT( isUpper c ); ... }
-- do { c <- getChar; MASSERT2( isUpper c, text "Bad" ); ... }
-- do { str <- getStr; ASSERTM( flagSet str ); .. }
......
......@@ -66,12 +66,9 @@ import Outputable
-- import StaticFlags
import Util
#if defined(__GLASGOW_HASKELL__)
--just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..))
#else
import Data.Array
#endif
import Data.Char ( chr, ord )
\end{code}
......@@ -260,15 +257,8 @@ iToBase62 n_
chooseChar62 :: FastInt -> Char
{-# INLINE chooseChar62 #-}
#if defined(__GLASGOW_HASKELL__)
--then FastInt == Int#
chooseChar62 n = C# (indexCharOffAddr# chars62 n)
!chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
#else
--Haskell98 arrays are portable
chooseChar62 n = (!) chars62 n
chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
#endif
\end{code}
%************************************************************************
......
......@@ -46,12 +46,9 @@ module Binary
lazyGet,
lazyPut,
#ifdef __GLASGOW_HASKELL__
-- GHC only:
ByteArray(..),
getByteArray,
putByteArray,
#endif
UserData(..), getUserData, setUserData,
newReadState, newWriteState,
......@@ -461,7 +458,6 @@ instance Binary DiffTime where
get bh = do r <- get bh
return $ fromRational r
#if defined(__GLASGOW_HASKELL__) || 1
--to quote binary-0.3 on this code idea,
--
-- TODO This instance is not architecture portable. GMP stores numbers as
......@@ -553,7 +549,6 @@ indexByteArray a# n# = W8# (indexWord8Array# a# n#)
instance (Integral a, Binary a) => Binary (Ratio a) where
put_ bh (a :% b) = do put_ bh a; put_ bh b
get bh = do a <- get bh; b <- get bh; return (a :% b)
#endif
instance Binary (Bin a) where
put_ bh (BinPtr i) = put_ bh (fromIntegral i :: Int32)
......
......@@ -11,8 +11,6 @@ module FastBool (
FastBool, fastBool, isFastTrue, fastOr, fastAnd
) where
#if defined(__GLASGOW_HASKELL__)
-- Import the beggars
import GHC.Exts
#ifdef DEBUG
......@@ -66,21 +64,6 @@ fastAnd _ x = x
#endif /* ! DEBUG */
#else /* ! __GLASGOW_HASKELL__ */
type FastBool = Bool
fastBool x = x
isFastTrue x = x
-- make sure these are as strict as the unboxed version,
-- so that the performance characteristics match
fastOr False False = False
fastOr _ _ = True
fastAnd True True = True
fastAnd _ _ = False
#endif /* ! __GLASGOW_HASKELL__ */
fastBool :: Bool -> FastBool
isFastTrue :: FastBool -> Bool
fastOr :: FastBool -> FastBool -> FastBool
......
......@@ -19,8 +19,6 @@ import FastTypes
import Data.IORef
import System.IO.Unsafe
#if defined(__GLASGOW_HASKELL__)
import GHC.Exts
import GHC.Word
import GHC.Base (unsafeChr)
......@@ -37,29 +35,6 @@ indexWord8OffFastPtrAsFastChar p i = indexCharOffAddr# p i
indexWord8OffFastPtrAsFastInt p i = word2Int# (indexWord8OffAddr# p i)
-- or ord# (indexCharOffAddr# p i)
#else /* ! __GLASGOW_HASKELL__ */
import Foreign.Ptr
import Data.Word
-- hey, no harm inlining it, :-P
{-# INLINE inlinePerformIO #-}
inlinePerformIO :: IO a -> a
inlinePerformIO = unsafePerformIO
unsafeDupableInterleaveIO :: IO a -> IO a
unsafeDupableInterleaveIO = unsafeInterleaveIO
-- truly, these functions are unsafe: they assume
-- a certain immutability of the pointer's target area.
indexWord8OffFastPtr p i = inlinePerformIO (peekByteOff p n) :: Word8
indexWord8OffFastPtrAsFastInt p i =
iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8))
indexWord8OffFastPtrAsFastChar p i =
fastChr (iUnbox (fromIntegral (inlinePerformIO (peekByteOff p n) :: Word8)))
#endif /* ! __GLASGOW_HASKELL__ */
--just so we can refer to the type clearly in a macro
type Global a = IORef a
global :: a -> Global a
......
......@@ -16,7 +16,6 @@ module FastMutInt(
readFastMutPtr, writeFastMutPtr
) where
#ifdef __GLASGOW_HASKELL__
#include "../includes/MachDeps.h"
#ifndef SIZEOF_HSINT
......@@ -26,12 +25,6 @@ module FastMutInt(
import GHC.Base
import GHC.Ptr
#else /* ! __GLASGOW_HASKELL__ */
import Data.IORef
#endif
newFastMutInt :: IO FastMutInt
readFastMutInt :: FastMutInt -> IO Int
writeFastMutInt :: FastMutInt -> Int -> IO ()
......@@ -42,7 +35,6 @@ writeFastMutPtr :: FastMutPtr -> Ptr a -> IO ()
\end{code}
\begin{code}
#ifdef __GLASGOW_HASKELL__
data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
newFastMutInt = IO $ \s ->
......@@ -72,43 +64,5 @@ readFastMutPtr (FastMutPtr arr) = IO $ \s ->
writeFastMutPtr (FastMutPtr arr) (Ptr i) = IO $ \s ->
case writeAddrArray# arr 0# i s of { s ->
(# s, () #) }
#else /* ! __GLASGOW_HASKELL__ */
--maybe someday we could use
--http://haskell.org/haskellwiki/Library/ArrayRef
--which has an implementation of IOURefs
--that is unboxed in GHC and just strict in all other compilers...
newtype FastMutInt = FastMutInt (IORef Int)
-- If any default value was chosen, it surely would be 0,
-- so we will use that since IORef requires a default value.
-- Or maybe it would be more interesting to package an error,
-- assuming nothing relies on being able to read a bogus Int?
-- That could interfere with its strictness for smart optimizers
-- (are they allowed to optimize a 'newtype' that way?) ...
-- Well, maybe that can be added (in DEBUG?) later.
newFastMutInt = fmap FastMutInt (newIORef 0)
readFastMutInt (FastMutInt ioRefInt) = readIORef ioRefInt
-- FastMutInt is strict in the value it contains.
writeFastMutInt (FastMutInt ioRefInt) i = i `seq` writeIORef ioRefInt i
newtype FastMutPtr = FastMutPtr (IORef (Ptr ()))
-- If any default value was chosen, it surely would be 0,
-- so we will use that since IORef requires a default value.
-- Or maybe it would be more interesting to package an error,
-- assuming nothing relies on being able to read a bogus Ptr?
-- That could interfere with its strictness for smart optimizers
-- (are they allowed to optimize a 'newtype' that way?) ...
-- Well, maybe that can be added (in DEBUG?) later.
newFastMutPtr = fmap FastMutPtr (newIORef (castPtr nullPtr))
readFastMutPtr (FastMutPtr ioRefPtr) = readIORef ioRefPtr
-- FastMutPtr is strict in the value it contains.
writeFastMutPtr (FastMutPtr ioRefPtr) i = i `seq` writeIORef ioRefPtr i
#endif
\end{code}
......@@ -50,9 +50,7 @@ module FastString
mkFastStringBytes,
mkFastStringByteList,
mkFastStringForeignPtr,
#if defined(__GLASGOW_HASKELL__)
mkFastString#,
#endif
-- ** Deconstruction
unpackFS, -- :: FastString -> String
......@@ -84,9 +82,7 @@ module FastString
-- ** Construction
sLit,
#if defined(__GLASGOW_HASKELL__)
mkLitString#,
#endif
mkLitString,
-- ** Deconstruction
......@@ -128,9 +124,7 @@ import Foreign.Safe
import GHC.Conc.Sync (sharedCAF)
#endif
#if defined(__GLASGOW_HASKELL__)
import GHC.Base ( unpackCString# )
#endif
#define hASH_TBL_SIZE 4091
#define hASH_TBL_SIZE_UNBOXED 4091#
......@@ -573,10 +567,8 @@ type LitString = Ptr Word8
--If it's commonly needed, we should perhaps have
--data LitString = LitString {-#UNPACK#-}!(FastPtr Word8) {-#UNPACK#-}!FastInt
#if defined(__GLASGOW_HASKELL__)
mkLitString# :: Addr# -> LitString
mkLitString# a# = Ptr a#
#endif
--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
......
......@@ -63,8 +63,6 @@ module FastTypes (
#include "HsVersions.h"
#if defined(__GLASGOW_HASKELL__)
-- Import the beggars
import ExtsCompat46
......@@ -112,78 +110,6 @@ pBox p = Ptr p
pUnbox (Ptr p) = p
castFastPtr p = p
#else /* ! __GLASGOW_HASKELL__ */
import Data.Char (ord, chr)
import Data.Bits
import Data.Word (Word) --is it a good idea to assume this exists too?
--does anyone need shiftRLFastInt? (apparently yes.)
import Foreign.Ptr
type FastInt = Int
_ILIT x = x
iBox x = x
iUnbox x = x
(+#) = (+)
(-#) = (-)
(*#) = (*)
quotFastInt = quot
--quotRemFastInt = quotRem
negateFastInt = negate
(==#) = (==)
(/=#) = (/=)
(<#) = (<)
(<=#) = (<=)
(>=#) = (>=)
(>#) = (>)
shiftLFastInt = shiftL
shiftR_FastInt = shiftR
shiftRAFastInt = shiftR
shiftRLFastInt n p = fromIntegral (shiftR (fromIntegral n :: Word) p)
--shiftLFastInt n p = n * (2 ^ p)
--assuming quot-Int is faster and the
--same for nonnegative arguments than div-Int
--shiftR_FastInt n p = n `quot` (2 ^ p)
--shiftRAFastInt n p = n `div` (2 ^ p)
--I couldn't figure out how to implement without Word nor Bits
--shiftRLFastInt n p = fromIntegral ((fromIntegral n :: Word) `quot` (2 ^ (fromIntegral p :: Word)))
bitAndFastInt = (.&.)
bitOrFastInt = (.|.)
type FastBool = Bool
fastBool x = x
isFastTrue x = x
-- make sure these are as strict as the unboxed version,
-- so that the performance characteristics match
fastOr False False = False
fastOr _ _ = True
fastAnd True True = True
fastAnd _ _ = False
type FastChar = Char
_CLIT c = c
cBox c = c
cUnbox c = c
fastOrd = ord
fastChr = chr --or unsafeChr if there was a standard location for it
eqFastChar = (==)
type FastPtr a = Ptr a
pBox p = p
pUnbox p = p
castFastPtr = castPtr
--These are among the type-signatures necessary for !ghc to compile
-- but break ghc (can't give a signature for an import...)
--Note that the comparisons actually do return Bools not FastBools.
(+#), (-#), (*#) :: FastInt -> FastInt -> FastInt
(==#), (/=#), (<#), (<=#), (>=#), (>#) :: FastInt -> FastInt -> Bool
#endif /* ! __GLASGOW_HASKELL__ */
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
......
......@@ -184,12 +184,10 @@ import Panic
import Numeric (fromRat)
import System.IO
#if defined(__GLASGOW_HASKELL__)
--for a RULES
import GHC.Base ( unpackCString# )
import GHC.Exts ( Int# )
import GHC.Ptr ( Ptr(..) )
#endif
-- Don't import Util( assertPanic ) because it makes a loop in the module structure
......@@ -556,13 +554,11 @@ ztext :: FastZString -> Doc
ztext s = case iUnbox (lengthFZS s) of {sl -> textBeside_ (ZStr s) sl Empty}
zeroWidthText s = textBeside_ (Str s) (_ILIT(0)) Empty
#if defined(__GLASGOW_HASKELL__)
-- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
-- intermediate packing/unpacking of the string.
{-# RULES
"text/str" forall a. text (unpackCString# a) = ptext (Ptr a)
#-}
#endif
nest k p = mkNest (iUnbox k) (reduceDoc p) -- Externally callable version
......
......@@ -737,7 +737,6 @@ matchVectors = snd . foldl' go (0 :: Int, IM.empty)
im' = IM.insertWith (.|.) (ord char) (2 ^ ix) im
in seq ix' $ seq im' $ (ix', im')
#ifdef __GLASGOW_HASKELL__
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
:: Word32 -> Int -> Int -> String -> String -> Int #-}
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistance'
......@@ -757,7 +756,6 @@ matchVectors = snd . foldl' go (0 :: Int, IM.empty)
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word32 #-}
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}
#endif
fuzzyMatch :: String -> [String] -> [String]
fuzzyMatch key vals = fuzzyLookup key [(v,v) | v <- vals]
......
/*
/*
* (c) The University of Glasgow 2002
*
* static versions of the inline functions in HsBase.h
......@@ -6,14 +6,9 @@
#define INLINE
#ifdef __GLASGOW_HASKELL__
# include "Rts.h"
#endif
#include "Rts.h"
#include "HsBase.h"
#ifdef __GLASGOW_HASKELL__
void errorBelch2(const char*s, char *t)
{
errorBelch(s,t);
......@@ -48,5 +43,3 @@ const char* localeEncoding(void)
#endif
}
#endif
#endif /* __GLASGOW_HASKELL__ */
......@@ -9,7 +9,7 @@
module GenUtils (
trace,
trace,
assocMaybe, assocMaybeErr,
arrElem,
......@@ -46,15 +46,9 @@ import Debug.Trace ( trace )
-- -------------------------------------------------------------------------
-- Here are two defs that everyone seems to define ...
-- Here are two defs that everyone seems to define ...
-- HBC has it in one of its builtin modules
#if defined(__GLASGOW_HASKELL__) || defined(__GOFER__)
--in 1.3: data Maybe a = Nothing | Just a deriving (Eq,Ord,Text)
#endif
infix 1 =: -- 1.3
type Assoc a b = (a,b) -- 1.3
(=:) a b = (a,b)
......@@ -68,10 +62,10 @@ mapMaybe f (a:r) = case f a of
-- This version returns nothing, if *any* one fails.
mapMaybeFail f (x:xs) = case f x of
Just x' -> case mapMaybeFail f xs of
Just xs' -> Just (x':xs')
Nothing -> Nothing
Nothing -> Nothing
Just x' -> case mapMaybeFail f xs of
Just xs' -> Just (x':xs')
Nothing -> Nothing
Nothing -> Nothing
mapMaybeFail f [] = Just []
maybeToBool :: Maybe a -> Bool
......@@ -87,7 +81,7 @@ maybeMap f (Just a) = Just (f a)
maybeMap f Nothing = Nothing
joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
joinMaybe _ Nothing Nothing = Nothing
joinMaybe _ (Just g) Nothing = Just g
joinMaybe _ Nothing (Just g) = Just g
......@@ -95,8 +89,8 @@ joinMaybe f (Just g) (Just h) = Just (f g h)
data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Show{-was:Text-})
-- @mkClosure@ makes a closure, when given a comparison and iteration loop.
-- Be careful, because if the functional always makes the object different,
-- @mkClosure@ makes a closure, when given a comparison and iteration loop.
-- Be careful, because if the functional always makes the object different,
-- This will never terminate.
mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
......@@ -112,14 +106,14 @@ foldb :: (a -> a -> a) -> [a] -> a
foldb f [] = error "can't reduce an empty list using foldb"
foldb f [x] = x
foldb f l = foldb f (foldb' l)
where
where
foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs
foldb' (x:y:xs) = f x y : foldb' xs
foldb' xs = xs
-- Merge two ordered lists into one ordered list.
-- Merge two ordered lists into one ordered list.
mergeWith :: (a -> a -> Bool) -> [a] -> [a] -> [a]
mergeWith :: (a -> a -> Bool) -> [a] -> [a] -> [a]
mergeWith _ [] ys = ys
mergeWith _ xs [] = xs
mergeWith le (x:xs) (y:ys)
......@@ -139,9 +133,9 @@ sortWith :: (a -> a -> Bool) -> [a] -> [a]
sortWith le [] = []
sortWith le lst = foldb (mergeWith le) (splitList lst)
where
splitList (a1:a2:a3:a4:a5:xs) =
insertWith le a1
(insertWith le a2
splitList (a1:a2:a3:a4:a5:xs) =
insertWith le a1
(insertWith le a2
(insertWith le a3
(insertWith le a4 [a5]))) : splitList xs
splitList [] = []
......@@ -166,12 +160,12 @@ copy :: Int -> a -> [a] -- make list of n copies of x
copy n x = take n xs where xs = x:xs
combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
combinePairs xs =
combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs]
combinePairs xs =
combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs]
where
combine [] = []
combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)
combine (a:r) = a : combine r
combine [] = []
combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)
combine (a:r) = a : combine r
assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b
assocMaybe env k = case [ val | (key,val) <- env, k == key] of
......@@ -189,9 +183,9 @@ deSucc (Succeeded e) = e
mapAccumL :: (a -> b -> (c,a)) -> a -> [b] -> ([c],a)
mapAccumL f s [] = ([],s)
mapAccumL f s (b:bs) = (c:cs,s'')
where
(c,s') = f s b
(cs,s'') = mapAccumL f s' bs
where
(c,s') = f s b
(cs,s'') = mapAccumL f s' bs
......@@ -200,7 +194,7 @@ mapAccumL f s (b:bs) = (c:cs,s'')
-- to optimise lookup.
arrElem :: (Ix a) => [a] -> a -> Bool
arrElem obj = \x -> inRange size x && arr ! x
arrElem obj = \x -> inRange size x && arr ! x
where
size = (maximum obj,minimum obj)
arr = listArray size [ i `elem` obj | i <- range size ]
......@@ -209,7 +203,7 @@ arrElem obj = \x -> inRange size x && arr ! x
-- again using arrays, of course. Remember @b@ can be a function !
-- Note again the use of partiual application.
arrCond :: (Ix a)
arrCond :: (Ix a)
=> (a,a) -- the bounds
-> [(Assoc [a] b)] -- the simple lookups
-> [(Assoc (a -> Bool) b)] -- the functional lookups
......@@ -233,12 +227,12 @@ memoise bds f = (!) arr
formatText :: Int -> [String] -> [String]
formatText n = map unwords . cutAt n []
where
cutAt :: Int -> [String] -> [String] -> [[String]]
cutAt m wds [] = [reverse wds]
cutAt m wds (wd:rest) = if len <= m || null wds
then cutAt (m-(len+1)) (wd:wds) rest
else reverse wds : cutAt n [] (wd:rest)
where len = length wd
cutAt :: Int -> [String] -> [String] -> [[String]]
cutAt m wds [] = [reverse wds]
cutAt m wds (wd:rest) = if len <= m || null wds
then cutAt (m-(len+1)) (wd:wds) rest
else reverse wds : cutAt n [] (wd:rest)
where len = length wd
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment