Commit 25d1eafe authored by ian@well-typed.com's avatar ian@well-typed.com

Remove nhc98-specific files and content

parent ab1d58b7
......@@ -50,21 +50,12 @@ import Prelude hiding (id,(.))
import Control.Category
import Control.Arrow
import Control.Monad (liftM, ap, MonadPlus(..))
#ifndef __NHC__
import Control.Monad.ST.Safe (ST)
import qualified Control.Monad.ST.Lazy.Safe as Lazy (ST)
#endif
import Data.Functor ((<$>), (<$))
import Data.Monoid (Monoid(..))
import Text.ParserCombinators.ReadP
#ifndef __NHC__
(ReadP)
#else
(ReadPN)
#define ReadP (ReadPN b)
#endif
import Text.ParserCombinators.ReadP (ReadP)
import Text.ParserCombinators.ReadPrec (ReadPrec)
#ifdef __GLASGOW_HASKELL__
......@@ -181,7 +172,6 @@ instance Applicative IO where
pure = return
(<*>) = ap
#ifndef __NHC__
instance Applicative (ST s) where
pure = return
(<*>) = ap
......@@ -189,7 +179,6 @@ instance Applicative (ST s) where
instance Applicative (Lazy.ST s) where
pure = return
(<*>) = ap
#endif
#ifdef __GLASGOW_HASKELL__
instance Applicative STM where
......
......@@ -52,9 +52,6 @@ module Control.Exception (
NonTermination(..),
NestedAtomically(..),
#endif
#ifdef __NHC__
System.ExitCode(), -- instance Exception
#endif
BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..),
......@@ -111,14 +108,12 @@ module Control.Exception (
-- asynchronous exceptions during a critical region.
mask,
#ifndef __NHC__
mask_,
uninterruptibleMask,
uninterruptibleMask_,
MaskingState(..),
getMaskingState,
allowInterrupt,
#endif
-- ** (deprecated) Asynchronous exception control
......@@ -159,10 +154,6 @@ import Data.Maybe
import Prelude hiding (catch)
#endif
#ifdef __NHC__
import System (ExitCode())
#endif
-- | You need this when using 'catches'.
data Handler a = forall e . Exception e => Handler (e -> IO a)
......
......@@ -84,13 +84,11 @@ module Control.Exception.Base (
-- ** Asynchronous exception control
mask,
#ifndef __NHC__
mask_,
uninterruptibleMask,
uninterruptibleMask_,
MaskingState(..),
getMaskingState,
#endif
-- ** (deprecated) Asynchronous exception control
......@@ -143,99 +141,6 @@ import Data.Dynamic
import Data.Either
import Data.Maybe
#ifdef __NHC__
import qualified IO as H'98 (catch)
import IO (bracket,ioError)
import DIOError -- defn of IOError type
import System (ExitCode())
import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Coerce (unsafeCoerce)
-- minimum needed for nhc98 to pretend it has Exceptions
{-
data Exception = IOException IOException
| ArithException ArithException
| ArrayException ArrayException
| AsyncException AsyncException
| ExitException ExitCode
deriving Show
-}
class ({-Typeable e,-} Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
data SomeException = forall e . Exception e => SomeException e
INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
instance Show SomeException where
showsPrec p (SomeException e) = showsPrec p e
instance Exception SomeException where
toException se = se
fromException = Just
type IOException = IOError
instance Exception IOError where
toException = SomeException
fromException (SomeException e) = Just (unsafeCoerce e)
instance Exception ExitCode where
toException = SomeException
fromException (SomeException e) = Just (unsafeCoerce e)
data ArithException
data ArrayException
data AsyncException
data AssertionFailed
data PatternMatchFail
data NoMethodError
data Deadlock
data BlockedIndefinitelyOnMVar
data BlockedIndefinitelyOnSTM
data ErrorCall
data RecConError
data RecSelError
data RecUpdError
instance Show ArithException
instance Show ArrayException
instance Show AsyncException
instance Show AssertionFailed
instance Show PatternMatchFail
instance Show NoMethodError
instance Show Deadlock
instance Show BlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnSTM
instance Show ErrorCall
instance Show RecConError
instance Show RecSelError
instance Show RecUpdError
catch :: Exception e
=> IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
catch io h = H'98.catch io (h . fromJust . fromException . toException)
throwIO :: Exception e => e -> IO a
throwIO = ioError . fromJust . fromException . toException
throw :: Exception e => e -> a
throw = unsafePerformIO . throwIO
evaluate :: a -> IO a
evaluate x = x `seq` return x
assert :: Bool -> a -> a
assert True x = x
assert False _ = throw (toException (UserError "" "Assertion failed"))
mask :: ((IO a-> IO a) -> IO a) -> IO a
mask action = action restore
where restore act = act
#endif
#ifdef __HUGS__
class (Typeable e, Show e) => Exception e where
toException :: e -> SomeException
......@@ -380,7 +285,6 @@ blocked = return False
-- might get a the opposite behaviour. This is ok, because 'catch' is an
-- 'IO' computation.
--
#ifndef __NHC__
catch :: Exception e
=> IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
......@@ -393,7 +297,6 @@ catch m h = Hugs.Exception.catchException m h'
Just e' -> h e'
Nothing -> throwIO e
#endif
#endif
-- | The function 'catchJust' is like 'catch', but it takes an extra
-- argument which is an /exception predicate/, a function which
......@@ -497,7 +400,6 @@ onException io what = io `catch` \e -> do _ <- what
--
-- > withFile name mode = bracket (openFile name mode) hClose
--
#ifndef __NHC__
bracket
:: IO a -- ^ computation to run first (\"acquire resource\")
-> (a -> IO b) -- ^ computation to run last (\"release resource\")
......@@ -509,7 +411,6 @@ bracket before after thing =
r <- restore (thing a) `onException` after a
_ <- after a
return r
#endif
-- | A specialised variant of 'bracket' with just a computation to run
-- afterward.
......@@ -541,7 +442,7 @@ bracketOnError before after thing =
a <- before
restore (thing a) `onException` after a
#if !(__GLASGOW_HASKELL__ || __NHC__)
#if !__GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
assert False _ = throw (AssertionFailed "")
......
{-# LANGUAGE Safe #-}
{-# OPTIONS_NHC98 --prelude #-}
-----------------------------------------------------------------------------
-- |
......
......@@ -331,17 +331,7 @@ instance Bits Int where
bit = primBitInt
testBit = primTestInt
bitSize _ = SIZEOF_HSINT*8
#elif defined(__NHC__)
(.&.) = nhc_primIntAnd
(.|.) = nhc_primIntOr
xor = nhc_primIntXor
complement = nhc_primIntCompl
shiftL = nhc_primIntLsh
shiftR = nhc_primIntRsh
bit = bitDefault
testBit = testBitDefault
bitSize _ = 32
#endif /* __NHC__ */
#endif
x `rotate` i
| i<0 && x<0 = let left = i+bitSize x in
......@@ -358,15 +348,6 @@ instance Bits Int where
instance FiniteBits Int where
finiteBitSize _ = WORD_SIZE_IN_BITS
#ifdef __NHC__
foreign import ccall nhc_primIntAnd :: Int -> Int -> Int
foreign import ccall nhc_primIntOr :: Int -> Int -> Int
foreign import ccall nhc_primIntXor :: Int -> Int -> Int
foreign import ccall nhc_primIntLsh :: Int -> Int -> Int
foreign import ccall nhc_primIntRsh :: Int -> Int -> Int
foreign import ccall nhc_primIntCompl :: Int -> Int
#endif /* __NHC__ */
#if defined(__GLASGOW_HASKELL__)
instance Bits Word where
{-# INLINE shift #-}
......
......@@ -29,14 +29,3 @@ module Data.Bool (
import GHC.Base
#endif
#ifdef __NHC__
import Prelude
import Prelude
( Bool(..)
, (&&)
, (||)
, not
, otherwise
)
#endif
......@@ -69,15 +69,6 @@ import Hugs.Prelude (Ix)
import Hugs.Char
#endif
#ifdef __NHC__
import Prelude
import Prelude(Char,String)
import Char
import Ix
import NHC.FFI (CInt)
foreign import ccall unsafe "WCsubst.h u_gencat" wgencat :: CInt -> CInt
#endif
-- | Convert a single digit 'Char' to the corresponding 'Int'.
-- This function fails unless its argument satisfies 'isHexDigit',
-- but recognises both upper and lower-case hexadecimal digits
......@@ -133,7 +124,7 @@ data GeneralCategory
-- | The Unicode general category of the character.
generalCategory :: Char -> GeneralCategory
#if defined(__GLASGOW_HASKELL__) || defined(__NHC__)
#if defined(__GLASGOW_HASKELL__)
generalCategory c = toEnum $ fromIntegral $ wgencat $ fromIntegral $ ord c
#endif
#ifdef __HUGS__
......@@ -203,9 +194,3 @@ isSeparator c = case generalCategory c of
ParagraphSeparator -> True
_ -> False
#ifdef __NHC__
-- dummy implementation
toTitle :: Char -> Char
toTitle = toUpper
#endif
......@@ -62,10 +62,6 @@ import Hugs.IORef
import Hugs.IOExts
#endif
#ifdef __NHC__
import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
#endif
#include "Typeable.h"
-------------------------------------------------------------
......
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, ScopedTypeVariables, PatternGuards #-}
{-# OPTIONS -Wall -fno-warn-unused-binds #-}
#ifndef __NHC__
{-# LANGUAGE DeriveDataTypeable #-}
#endif
-----------------------------------------------------------------------------
-- |
......@@ -40,17 +38,13 @@ module Data.Fixed
) where
import Prelude -- necessary to get dependencies right
#ifndef __NHC__
import Data.Typeable
import Data.Data
#endif
import GHC.Read
import Text.ParserCombinators.ReadPrec
import Text.Read.Lex
#ifndef __NHC__
default () -- avoid any defaulting shenanigans
#endif
-- | generalisation of 'div' to any instance of Real
div' :: (Real a,Integral b) => a -> a -> b
......@@ -68,13 +62,8 @@ mod' n d = n - (fromInteger f) * d where
-- | The type parameter should be an instance of 'HasResolution'.
newtype Fixed a = MkFixed Integer
#ifndef __NHC__
deriving (Eq,Ord,Typeable)
#else
deriving (Eq,Ord)
#endif
#ifndef __NHC__
-- We do this because the automatically derived Data instance requires (Data a) context.
-- Our manual instance has the more general (Typeable a) context.
tyFixed :: DataType
......@@ -86,7 +75,6 @@ instance (Typeable a) => Data (Fixed a) where
gunfold k z _ = k (z MkFixed)
dataTypeOf _ = tyFixed
toConstr _ = conMkFixed
#endif
class HasResolution a where
resolution :: p a -> Integer
......@@ -176,63 +164,49 @@ convertFixed (Number n)
convertFixed _ = pfail
data E0 = E0
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E0 where
resolution _ = 1
-- | resolution of 1, this works the same as Integer
type Uni = Fixed E0
data E1 = E1
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E1 where
resolution _ = 10
-- | resolution of 10^-1 = .1
type Deci = Fixed E1
data E2 = E2
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E2 where
resolution _ = 100
-- | resolution of 10^-2 = .01, useful for many monetary currencies
type Centi = Fixed E2
data E3 = E3
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E3 where
resolution _ = 1000
-- | resolution of 10^-3 = .001
type Milli = Fixed E3
data E6 = E6
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E6 where
resolution _ = 1000000
-- | resolution of 10^-6 = .000001
type Micro = Fixed E6
data E9 = E9
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E9 where
resolution _ = 1000000000
-- | resolution of 10^-9 = .000000001
type Nano = Fixed E9
data E12 = E12
#ifndef __NHC__
deriving (Typeable)
#endif
instance HasResolution E12 where
resolution _ = 1000000000000
-- | resolution of 10^-12 = .000000000001
......
......@@ -68,10 +68,6 @@ import Control.Monad (MonadPlus(..))
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Monoid
#ifdef __NHC__
import Control.Arrow (ArrowZero(..)) -- work around nhc98 typechecker problem
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
#endif
......@@ -80,8 +76,6 @@ import GHC.Exts (build)
import GHC.Arr
#elif defined(__HUGS__)
import Hugs.Array
#elif defined(__NHC__)
import Array
#endif
-- | Data structures that can be folded.
......
......@@ -51,16 +51,6 @@ import GHC.Weak
#endif
#endif /* __GLASGOW_HASKELL__ */
#ifdef __NHC__
import NHC.IOExtras
( IORef
, newIORef
, readIORef
, writeIORef
, excludeFinalisers
)
#endif
#if defined(__GLASGOW_HASKELL__) && !defined(__PARALLEL_HASKELL__)
-- |Make a 'Weak' pointer to an 'IORef', using the second argument as a finalizer
-- to run when 'IORef' is garbage-collected
......@@ -120,13 +110,6 @@ atomicModifyIORef = plainModifyIORef -- Hugs has no preemption
where plainModifyIORef r f = do
a <- readIORef r
case f a of (a',b) -> writeIORef r a' >> return b
#elif defined(__NHC__)
atomicModifyIORef r f =
excludeFinalisers $ do
a <- readIORef r
let (a',b) = f a
writeIORef r a'
return b
#endif
-- | Strict version of 'atomicModifyIORef'. This forces both the value stored
......
......@@ -35,13 +35,6 @@ import GHC.Int ( Int8, Int16, Int32, Int64 )
import Hugs.Int ( Int8, Int16, Int32, Int64 )
#endif
#ifdef __NHC__
import Prelude
import Prelude (Int)
import NHC.FFI (Int8, Int16, Int32, Int64)
import NHC.SizedTypes (Int8, Int16, Int32, Int64) -- instances of Bits
#endif
{- $notes
* All arithmetic is performed modulo 2^n, where @n@ is the number of
......
......@@ -72,7 +72,3 @@ import GHC.Arr
import Hugs.Prelude( Ix(..) )
#endif
#ifdef __NHC__
import Ix (Ix(..))
#endif
......@@ -17,11 +17,6 @@
module Data.List
(
#ifdef __NHC__
[] (..)
,
#endif
-- * Basic functions
(++)
......@@ -210,10 +205,6 @@ module Data.List
) where
#ifdef __NHC__
import Prelude
#endif
import Data.Maybe
import Data.Char ( isSpace )
......
......@@ -35,21 +35,6 @@ module Data.Maybe
import GHC.Base
#endif
#ifdef __NHC__
import Prelude
import Prelude (Maybe(..), maybe)
import Maybe
( isJust
, isNothing
, fromJust
, fromMaybe
, listToMaybe
, maybeToList
, catMaybes
, mapMaybe
)
#else
#ifndef __HUGS__
-- ---------------------------------------------------------------------------
-- The Maybe type, and instances
......@@ -146,5 +131,3 @@ mapMaybe f (x:xs) =
Nothing -> rs
Just r -> r:rs
#endif /* else not __NHC__ */
......@@ -119,15 +119,6 @@ import Hugs.IOArray
import Hugs.ConcBase ( MVar )
#endif
#ifdef __NHC__
import NHC.IOExtras (IOArray,IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
import IO (Handle)
import Ratio (Ratio)
-- For the Typeable instance
import NHC.FFI ( Ptr,FunPtr,StablePtr,ForeignPtr )
import Array ( Array )
#endif
#include "OldTypeable.h"
{-# DEPRECATED typeRepKey "TypeRep itself is now an instance of Ord" #-}
......
......@@ -508,14 +508,12 @@ INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
#endif
#ifndef __NHC__
INSTANCE_TYPEABLE2((,),pairTc,"(,)")
INSTANCE_TYPEABLE3((,,),tup3Tc,"(,,)")
INSTANCE_TYPEABLE4((,,,),tup4Tc,"(,,,)")
INSTANCE_TYPEABLE5((,,,,),tup5Tc,"(,,,,)")
INSTANCE_TYPEABLE6((,,,,,),tup6Tc,"(,,,,,)")
INSTANCE_TYPEABLE7((,,,,,,),tup7Tc,"(,,,,,,)")
#endif /* __NHC__ */
INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr")
......@@ -536,9 +534,7 @@ INSTANCE_TYPEABLE0(Char,charTc,"Char")
INSTANCE_TYPEABLE0(Float,floatTc,"Float")
INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
INSTANCE_TYPEABLE0(Int,intTc,"Int")
#ifndef __NHC__
INSTANCE_TYPEABLE0(Word,wordTc,"Word" )
#endif
INSTANCE_TYPEABLE0(Integer,integerTc,"Integer"