-- * Booleans
Bool(..),
-- ** Operations
- (&&), -- :: Bool -> Bool -> Bool
- (||), -- :: Bool -> Bool -> Bool
- not, -- :: Bool -> Bool
- otherwise, -- :: Bool
+ (&&), -- :: Bool -> Bool -> Bool
+ (||), -- :: Bool -> Bool -> Bool
+ not, -- :: Bool -> Bool
+ otherwise, -- :: Bool
) where
#ifdef __GLASGOW_HASKELL__
--
-----------------------------------------------------------------------------
-module Data.Char
+module Data.Char
(
Char
-- * String representations
, showLitChar -- :: Char -> ShowS
- , lexLitChar -- :: ReadS String
+ , lexLitChar -- :: ReadS String
, readLitChar -- :: ReadS Char
-- Implementation checked wrt. Haskell 98 lib report, 1/99.
-- (i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@).
digitToInt :: Char -> Int
digitToInt c
- | isDigit c = ord c - ord '0'
+ | isDigit c = ord c - ord '0'
| c >= 'a' && c <= 'f' = ord c - ord 'a' + 10
| c >= 'A' && c <= 'F' = ord c - ord 'A' + 10
- | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
+ | otherwise = error ("Char.digitToInt: not a digit " ++ show c) -- sigh
#ifndef __GLASGOW_HASKELL__
isAsciiUpper, isAsciiLower :: Char -> Bool
-----------------------------------------------------------------------------
module Data.HashTable (
- -- * Basic hash table operations
- HashTable, new, insert, delete, lookup, update,
- -- * Converting to and from lists
- fromList, toList,
- -- * Hash functions
- -- $hash_functions
- hashInt, hashString,
- prime,
- -- * Diagnostics
- longestChain
+ -- * Basic hash table operations
+ HashTable, new, insert, delete, lookup, update,
+ -- * Converting to and from lists
+ fromList, toList,
+ -- * Hash functions
+ -- $hash_functions
+ hashInt, hashString,
+ prime,
+ -- * Diagnostics
+ longestChain
) where
-- This module is imported by Data.Dynamic, which is pretty low down in the
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#else
-import Prelude hiding ( lookup )
+import Prelude hiding ( lookup )
#endif
-import Data.Tuple ( fst )
+import Data.Tuple ( fst )
import Data.Bits
import Data.Maybe
-import Data.List ( maximumBy, length, concat, foldl', partition )
-import Data.Int ( Int32 )
+import Data.List ( maximumBy, length, concat, foldl', partition )
+import Data.Int ( Int32 )
#if defined(__GLASGOW_HASKELL__)
import GHC.Num
-import GHC.Real ( fromIntegral )
-import GHC.Show ( Show(..) )
-import GHC.Int ( Int64 )
+import GHC.Real ( fromIntegral )
+import GHC.Show ( Show(..) )
+import GHC.Int ( Int64 )
-import GHC.IOBase ( IO, IOArray, newIOArray,
- unsafeReadIOArray, unsafeWriteIOArray, unsafePerformIO,
- IORef, newIORef, readIORef, writeIORef )
+import GHC.IOBase ( IO, IOArray, newIOArray,
+ unsafeReadIOArray, unsafeWriteIOArray, unsafePerformIO,
+ IORef, newIORef, readIORef, writeIORef )
#else
-import Data.Char ( ord )
-import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
-import System.IO.Unsafe ( unsafePerformIO )
-import Data.Int ( Int64 )
+import Data.Char ( ord )
+import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
+import System.IO.Unsafe ( unsafePerformIO )
+import Data.Int ( Int64 )
# if defined(__HUGS__)
-import Hugs.IOArray ( IOArray, newIOArray,
- unsafeReadIOArray, unsafeWriteIOArray )
+import Hugs.IOArray ( IOArray, newIOArray,
+ unsafeReadIOArray, unsafeWriteIOArray )
# elif defined(__NHC__)
-import NHC.IOExtras ( IOArray, newIOArray, readIOArray, writeIOArray )
+import NHC.IOExtras ( IOArray, newIOArray, readIOArray, writeIOArray )
# endif
#endif
-import Control.Monad ( mapM, mapM_, sequence_ )
+import Control.Monad ( mapM, mapM_, sequence_ )
-----------------------------------------------------------------------
#endif
data HashTable key val = HashTable {
- cmp :: !(key -> key -> Bool),
- hash_fn :: !(key -> Int32),
+ cmp :: !(key -> key -> Bool),
+ hash_fn :: !(key -> Int32),
tab :: !(IORef (HT key val))
}
-- TODO: the IORef should really be an MVar.
data HT key val
= HT {
- kcount :: !Int32, -- Total number of keys.
+ kcount :: !Int32, -- Total number of keys.
bmask :: !Int32,
- buckets :: !(HTArray [(key,val)])
+ buckets :: !(HTArray [(key,val)])
}
-- ------------------------------------------------------------
--
new
:: (key -> key -> Bool) -- ^ @eq@: An equality comparison on keys
- -> (key -> Int32) -- ^ @hash@: A hash function on keys
+ -> (key -> Int32) -- ^ @hash@: A hash function on keys
-> IO (HashTable key val) -- ^ Returns: an empty hash table
new cmpr hash = do
-- The -fallow-overlapping-instances flag allows the user to over-ride
-- the instances for Typeable given here. In particular, we provide an instance
--- instance ... => Typeable (s a)
+-- instance ... => Typeable (s a)
-- But a user might want to say
--- instance ... => Typeable (MyType a b)
+-- instance ... => Typeable (MyType a b)
-----------------------------------------------------------------------------
-- |
module Data.Typeable
(
- -- * The Typeable class
- Typeable( typeOf ), -- :: a -> TypeRep
-
- -- * Type-safe cast
- cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
- gcast, -- a generalisation of cast
-
- -- * Type representations
- TypeRep, -- abstract, instance of: Eq, Show, Typeable
- TyCon, -- abstract, instance of: Eq, Show, Typeable
- showsTypeRep,
-
- -- * Construction of type representations
- mkTyCon, -- :: String -> TyCon
- mkTyConApp, -- :: TyCon -> [TypeRep] -> TypeRep
- mkAppTy, -- :: TypeRep -> TypeRep -> TypeRep
- mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
-
- -- * Observation of type representations
- splitTyConApp, -- :: TypeRep -> (TyCon, [TypeRep])
- funResultTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
- typeRepTyCon, -- :: TypeRep -> TyCon
- typeRepArgs, -- :: TypeRep -> [TypeRep]
- tyConString, -- :: TyCon -> String
- typeRepKey, -- :: TypeRep -> IO Int
-
- -- * The other Typeable classes
- -- | /Note:/ The general instances are provided for GHC only.
- Typeable1( typeOf1 ), -- :: t a -> TypeRep
- Typeable2( typeOf2 ), -- :: t a b -> TypeRep
- Typeable3( typeOf3 ), -- :: t a b c -> TypeRep
- Typeable4( typeOf4 ), -- :: t a b c d -> TypeRep
- Typeable5( typeOf5 ), -- :: t a b c d e -> TypeRep
- Typeable6( typeOf6 ), -- :: t a b c d e f -> TypeRep
- Typeable7( typeOf7 ), -- :: t a b c d e f g -> TypeRep
- gcast1, -- :: ... => c (t a) -> Maybe (c (t' a))
- gcast2, -- :: ... => c (t a b) -> Maybe (c (t' a b))
-
- -- * Default instances
- -- | /Note:/ These are not needed by GHC, for which these instances
- -- are generated by general instance declarations.
- typeOfDefault, -- :: (Typeable1 t, Typeable a) => t a -> TypeRep
- typeOf1Default, -- :: (Typeable2 t, Typeable a) => t a b -> TypeRep
- typeOf2Default, -- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep
- typeOf3Default, -- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep
- typeOf4Default, -- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep
- typeOf5Default, -- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep
- typeOf6Default -- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep
+ -- * The Typeable class
+ Typeable( typeOf ), -- :: a -> TypeRep
+
+ -- * Type-safe cast
+ cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
+ gcast, -- a generalisation of cast
+
+ -- * Type representations
+ TypeRep, -- abstract, instance of: Eq, Show, Typeable
+ TyCon, -- abstract, instance of: Eq, Show, Typeable
+ showsTypeRep,
+
+ -- * Construction of type representations
+ mkTyCon, -- :: String -> TyCon
+ mkTyConApp, -- :: TyCon -> [TypeRep] -> TypeRep
+ mkAppTy, -- :: TypeRep -> TypeRep -> TypeRep
+ mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
+
+ -- * Observation of type representations
+ splitTyConApp, -- :: TypeRep -> (TyCon, [TypeRep])
+ funResultTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
+ typeRepTyCon, -- :: TypeRep -> TyCon
+ typeRepArgs, -- :: TypeRep -> [TypeRep]
+ tyConString, -- :: TyCon -> String
+ typeRepKey, -- :: TypeRep -> IO Int
+
+ -- * The other Typeable classes
+ -- | /Note:/ The general instances are provided for GHC only.
+ Typeable1( typeOf1 ), -- :: t a -> TypeRep
+ Typeable2( typeOf2 ), -- :: t a b -> TypeRep
+ Typeable3( typeOf3 ), -- :: t a b c -> TypeRep
+ Typeable4( typeOf4 ), -- :: t a b c d -> TypeRep
+ Typeable5( typeOf5 ), -- :: t a b c d e -> TypeRep
+ Typeable6( typeOf6 ), -- :: t a b c d e f -> TypeRep
+ Typeable7( typeOf7 ), -- :: t a b c d e f g -> TypeRep
+ gcast1, -- :: ... => c (t a) -> Maybe (c (t' a))
+ gcast2, -- :: ... => c (t a b) -> Maybe (c (t' a b))
+
+ -- * Default instances
+ -- | /Note:/ These are not needed by GHC, for which these instances
+ -- are generated by general instance declarations.
+ typeOfDefault, -- :: (Typeable1 t, Typeable a) => t a -> TypeRep
+ typeOf1Default, -- :: (Typeable2 t, Typeable a) => t a b -> TypeRep
+ typeOf2Default, -- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep
+ typeOf3Default, -- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep
+ typeOf4Default, -- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep
+ typeOf5Default, -- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep
+ typeOf6Default -- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep
) where
import GHC.Err
import GHC.Num
import GHC.Float
-import GHC.Real ( rem, Ratio )
-import GHC.IOBase (IORef,newIORef,unsafePerformIO)
+import GHC.Real ( rem, Ratio )
+import GHC.IOBase (IORef,newIORef,unsafePerformIO)
-- These imports are so we can define Typeable instances
-- It'd be better to give Typeable instances in the modules themselves
-- but they all have to be compiled before Typeable
-import GHC.IOBase ( IO, MVar, Exception, ArithException, IOException,
- ArrayException, AsyncException, Handle )
-import GHC.ST ( ST )
-import GHC.STRef ( STRef )
+import GHC.IOBase ( IO, MVar, Exception, ArithException, IOException,
+ ArrayException, AsyncException, Handle )
+import GHC.ST ( ST )
+import GHC.STRef ( STRef )
import GHC.Ptr ( Ptr, FunPtr )
import GHC.ForeignPtr ( ForeignPtr )
-import GHC.Stable ( StablePtr, newStablePtr, freeStablePtr,
- deRefStablePtr, castStablePtrToPtr,
- castPtrToStablePtr )
-import GHC.Exception ( block )
-import GHC.Arr ( Array, STArray )
+import GHC.Stable ( StablePtr, newStablePtr, freeStablePtr,
+ deRefStablePtr, castStablePtrToPtr,
+ castPtrToStablePtr )
+import GHC.Exception ( block )
+import GHC.Arr ( Array, STArray )
#endif
#ifdef __HUGS__
-import Hugs.Prelude ( Key(..), TypeRep(..), TyCon(..), Ratio,
- Exception, ArithException, IOException,
- ArrayException, AsyncException, Handle,
- Ptr, FunPtr, ForeignPtr, StablePtr )
-import Hugs.IORef ( IORef, newIORef, readIORef, writeIORef )
-import Hugs.IOExts ( unsafePerformIO )
- -- For the Typeable instance
-import Hugs.Array ( Array )
-import Hugs.ConcBase ( MVar )
+import Hugs.Prelude ( Key(..), TypeRep(..), TyCon(..), Ratio,
+ Exception, ArithException, IOException,
+ ArrayException, AsyncException, Handle,
+ Ptr, FunPtr, ForeignPtr, StablePtr )
+import Hugs.IORef ( IORef, newIORef, readIORef, writeIORef )
+import Hugs.IOExts ( unsafePerformIO )
+ -- For the Typeable instance
+import Hugs.Array ( Array )
+import Hugs.ConcBase ( MVar )
#endif
#ifdef __NHC__
import NHC.IOExtras (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 )
+ -- For the Typeable instance
+import NHC.FFI ( Ptr,FunPtr,StablePtr,ForeignPtr )
+import Array ( Array )
#endif
#include "Typeable.h"
-------------------------------------------------------------
--
--- Type representations
+-- Type representations
--
-------------------------------------------------------------
typeRepKey :: TypeRep -> IO Int
typeRepKey (TypeRep (Key i) _ _) = return i
- --
- -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")
- -- [fTy,fTy,fTy])
- --
- -- returns "(Foo,Foo,Foo)"
- --
- -- The TypeRep Show instance promises to print tuple types
- -- correctly. Tuple type constructors are specified by a
- -- sequence of commas, e.g., (mkTyCon ",,,,") returns
- -- the 5-tuple tycon.
+ --
+ -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")
+ -- [fTy,fTy,fTy])
+ --
+ -- returns "(Foo,Foo,Foo)"
+ --
+ -- The TypeRep Show instance promises to print tuple types
+ -- correctly. Tuple type constructors are specified by a
+ -- sequence of commas, e.g., (mkTyCon ",,,,") returns
+ -- the 5-tuple tycon.
----------------- Construction --------------------
-- > mkTyCon "a" == mkTyCon "a"
--
-mkTyCon :: String -- ^ the name of the type constructor (should be unique
- -- in the program, so it might be wise to use the
- -- fully qualified name).
- -> TyCon -- ^ A unique 'TyCon' object
+mkTyCon :: String -- ^ the name of the type constructor (should be unique
+ -- in the program, so it might be wise to use the
+ -- fully qualified name).
+ -> TyCon -- ^ A unique 'TyCon' object
mkTyCon str = TyCon (mkTyConKey str) str
----------------- Observation ---------------------
[] -> showsPrec p tycon
[x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
[a,r] | tycon == funTc -> showParen (p > 8) $
- showsPrec 9 a .
+ showsPrec 9 a .
showString " -> " .
showsPrec 8 r
xs | isTupleTyCon tycon -> showTuple xs
- | otherwise ->
- showParen (p > 9) $
- showsPrec p tycon .
- showChar ' ' .
- showArgs tys
+ | otherwise ->
+ showParen (p > 9) $
+ showsPrec p tycon .
+ showChar ' ' .
+ showArgs tys
showsTypeRep :: TypeRep -> ShowS
showsTypeRep = shows
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (TyCon _ ('(':',':_)) = True
-isTupleTyCon _ = False
+isTupleTyCon _ = False
-- Some (Show.TypeRep) helpers:
-------------------------------------------------------------
--
--- The Typeable class and friends
+-- The Typeable class and friends
--
-------------------------------------------------------------
-------------------------------------------------------------
--
--- Type-safe cast
+-- Type-safe cast
--
-------------------------------------------------------------
cast :: (Typeable a, Typeable b) => a -> Maybe b
cast x = r
where
- r = if typeOf x == typeOf (fromJust r)
+ r = if typeOf x == typeOf (fromJust r)
then Just $ unsafeCoerce x
- else Nothing
+ else Nothing
-- | A flexible variation parameterised in a type constructor
gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
-------------------------------------------------------------
--
--- Instances of the Typeable classes for Prelude types
+-- Instances of the Typeable classes for Prelude types
--
-------------------------------------------------------------
---------------------------------------------
--
--- Internals
+-- Internals
--
---------------------------------------------
hashKP :: KeyPr -> Int32
hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime
-data Cache = Cache { next_key :: !(IORef Key), -- Not used by GHC (calls genSym instead)
- tc_tbl :: !(HT.HashTable String Key),
- ap_tbl :: !(HT.HashTable KeyPr Key) }
+data Cache = Cache { next_key :: !(IORef Key), -- Not used by GHC (calls genSym instead)
+ tc_tbl :: !(HT.HashTable String Key),
+ ap_tbl :: !(HT.HashTable KeyPr Key) }
{-# NOINLINE cache #-}
#ifdef __GLASGOW_HASKELL__
cache :: Cache
cache = unsafePerformIO $ do
- empty_tc_tbl <- HT.new (==) HT.hashString
- empty_ap_tbl <- HT.new (==) hashKP
- key_loc <- newIORef (Key 1)
- let ret = Cache { next_key = key_loc,
- tc_tbl = empty_tc_tbl,
- ap_tbl = empty_ap_tbl }
+ empty_tc_tbl <- HT.new (==) HT.hashString
+ empty_ap_tbl <- HT.new (==) hashKP
+ key_loc <- newIORef (Key 1)
+ let ret = Cache { next_key = key_loc,
+ tc_tbl = empty_tc_tbl,
+ ap_tbl = empty_ap_tbl }
#ifdef __GLASGOW_HASKELL__
- block $ do
- stable_ref <- newStablePtr ret
- let ref = castStablePtrToPtr stable_ref
- ref2 <- getOrSetTypeableStore ref
- if ref==ref2
- then deRefStablePtr stable_ref
- else do
- freeStablePtr stable_ref
- deRefStablePtr
- (castPtrToStablePtr ref2)
+ block $ do
+ stable_ref <- newStablePtr ret
+ let ref = castStablePtrToPtr stable_ref
+ ref2 <- getOrSetTypeableStore ref
+ if ref==ref2
+ then deRefStablePtr stable_ref
+ else do
+ freeStablePtr stable_ref
+ deRefStablePtr
+ (castPtrToStablePtr ref2)
#else
- return ret
+ return ret
#endif
newKey :: IORef Key -> IO Key
newKey kloc = do i <- genSym; return (Key i)
#else
newKey kloc = do { k@(Key i) <- readIORef kloc ;
- writeIORef kloc (Key (i+1)) ;
- return k }
+ writeIORef kloc (Key (i+1)) ;
+ return k }
#endif
#ifdef __GLASGOW_HASKELL__
mkTyConKey :: String -> Key
mkTyConKey str
= unsafePerformIO $ do
- let Cache {next_key = kloc, tc_tbl = tbl} = cache
- mb_k <- HT.lookup tbl str
- case mb_k of
- Just k -> return k
- Nothing -> do { k <- newKey kloc ;
- HT.insert tbl str k ;
- return k }
+ let Cache {next_key = kloc, tc_tbl = tbl} = cache
+ mb_k <- HT.lookup tbl str
+ case mb_k of
+ Just k -> return k
+ Nothing -> do { k <- newKey kloc ;
+ HT.insert tbl str k ;
+ return k }
appKey :: Key -> Key -> Key
appKey k1 k2
= unsafePerformIO $ do
- let Cache {next_key = kloc, ap_tbl = tbl} = cache
- mb_k <- HT.lookup tbl kpr
- case mb_k of
- Just k -> return k
- Nothing -> do { k <- newKey kloc ;
- HT.insert tbl kpr k ;
- return k }
+ let Cache {next_key = kloc, ap_tbl = tbl} = cache
+ mb_k <- HT.lookup tbl kpr
+ case mb_k of
+ Just k -> return k
+ Nothing -> do { k <- newKey kloc ;
+ HT.insert tbl kpr k ;
+ return k }
where
kpr = KeyPr k1 k2
module Foreign.Ptr (
-- * Data pointers
-
+
Ptr, -- data Ptr a
nullPtr, -- :: Ptr a
castPtr, -- :: Ptr a -> Ptr b
plusPtr, -- :: Ptr a -> Int -> Ptr b
alignPtr, -- :: Ptr a -> Int -> Ptr a
minusPtr, -- :: Ptr a -> Ptr b -> Int
-
+
-- * Function pointers
-
+
FunPtr, -- data FunPtr a
nullFunPtr, -- :: FunPtr a
castFunPtr, -- :: FunPtr a -> FunPtr b
castFunPtrToPtr, -- :: FunPtr a -> Ptr b
castPtrToFunPtr, -- :: Ptr a -> FunPtr b
-
+
freeHaskellFunPtr, -- :: FunPtr a -> IO ()
-- Free the function pointer created by foreign export dynamic.
import GHC.Real
import GHC.Show
import GHC.Enum
-import GHC.Word ( Word(..) )
+import GHC.Word ( Word(..) )
import Data.Int
import Data.Word
#else
-import Control.Monad ( liftM )
+import Control.Monad ( liftM )
import Foreign.C.Types
#endif
import Data.Bits
-import Data.Typeable ( Typeable(..), mkTyCon, mkTyConApp )
+import Data.Typeable ( Typeable(..), mkTyCon, mkTyConApp )
import Foreign.Storable ( Storable(..) )
#ifdef __NHC__
-- | An unsigned integral type that can be losslessly converted to and from
-- @Ptr@.
INTEGRAL_TYPE(WordPtr,tyConWordPtr,"WordPtr",Word)
- -- Word and Int are guaranteed pointer-sized in GHC
+ -- Word and Int are guaranteed pointer-sized in GHC
-- | A signed integral type that can be losslessly converted to and from
-- @Ptr@.
INTEGRAL_TYPE(IntPtr,tyConIntPtr,"IntPtr",Int)
- -- Word and Int are guaranteed pointer-sized in GHC
+ -- Word and Int are guaranteed pointer-sized in GHC
-- | casts a @Ptr@ to a @WordPtr@
ptrToWordPtr :: Ptr a -> WordPtr
-----------------------------------------------------------------------------
module Foreign.Storable
- ( Storable(
- sizeOf, -- :: a -> Int
- alignment, -- :: a -> Int
- peekElemOff, -- :: Ptr a -> Int -> IO a
- pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
- peekByteOff, -- :: Ptr b -> Int -> IO a
- pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
- peek, -- :: Ptr a -> IO a
- poke) -- :: Ptr a -> a -> IO ()
+ ( Storable(
+ sizeOf, -- :: a -> Int
+ alignment, -- :: a -> Int
+ peekElemOff, -- :: Ptr a -> Int -> IO a
+ pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
+ peekByteOff, -- :: Ptr b -> Int -> IO a
+ pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
+ peek, -- :: Ptr a -> IO a
+ poke) -- :: Ptr a -> a -> IO ()
) where
,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)
#else
-import Control.Monad ( liftM )
+import Control.Monad ( liftM )
#include "MachDeps.h"
#include "HsBaseConfig.h"
#ifdef __GLASGOW_HASKELL__
import GHC.Storable
-import GHC.Stable ( StablePtr )
+import GHC.Stable ( StablePtr )
import GHC.Num
import GHC.Int
import GHC.Word
peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
-#define STORABLE(T,size,align,read,write) \
-instance Storable (T) where { \
- sizeOf _ = size; \
- alignment _ = align; \
- peekElemOff = read; \
+#define STORABLE(T,size,align,read,write) \
+instance Storable (T) where { \
+ sizeOf _ = size; \
+ alignment _ = align; \
+ peekElemOff = read; \
pokeElemOff = write }
#ifdef __GLASGOW_HASKELL__
STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
- readWideCharOffPtr,writeWideCharOffPtr)
+ readWideCharOffPtr,writeWideCharOffPtr)
#elif defined(__HUGS__)
STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
- readCharOffPtr,writeCharOffPtr)
+ readCharOffPtr,writeCharOffPtr)
#endif
STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
- readIntOffPtr,writeIntOffPtr)
+ readIntOffPtr,writeIntOffPtr)
#ifndef __NHC__
STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
- readWordOffPtr,writeWordOffPtr)
+ readWordOffPtr,writeWordOffPtr)
#endif
STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
- readPtrOffPtr,writePtrOffPtr)
+ readPtrOffPtr,writePtrOffPtr)
STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
- readFunPtrOffPtr,writeFunPtrOffPtr)
+ readFunPtrOffPtr,writeFunPtrOffPtr)
STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
- readStablePtrOffPtr,writeStablePtrOffPtr)
+ readStablePtrOffPtr,writeStablePtrOffPtr)
STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
- readFloatOffPtr,writeFloatOffPtr)
+ readFloatOffPtr,writeFloatOffPtr)
STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
- readDoubleOffPtr,writeDoubleOffPtr)
+ readDoubleOffPtr,writeDoubleOffPtr)
STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
- readWord8OffPtr,writeWord8OffPtr)
+ readWord8OffPtr,writeWord8OffPtr)
STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
- readWord16OffPtr,writeWord16OffPtr)
+ readWord16OffPtr,writeWord16OffPtr)
STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
- readWord32OffPtr,writeWord32OffPtr)
+ readWord32OffPtr,writeWord32OffPtr)
STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
- readWord64OffPtr,writeWord64OffPtr)
+ readWord64OffPtr,writeWord64OffPtr)
STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
- readInt8OffPtr,writeInt8OffPtr)
+ readInt8OffPtr,writeInt8OffPtr)
STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
- readInt16OffPtr,writeInt16OffPtr)
+ readInt16OffPtr,writeInt16OffPtr)
STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
- readInt32OffPtr,writeInt32OffPtr)
+ readInt32OffPtr,writeInt32OffPtr)
STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
- readInt64OffPtr,writeInt64OffPtr)
+ readInt64OffPtr,writeInt64OffPtr)
#endif
-- #hide
module GHC.Pack
(
- -- (**) - emitted by compiler.
+ -- (**) - emitted by compiler.
- packCString#, -- :: [Char] -> ByteArray# (**)
- unpackCString,
- unpackCString#, -- :: Addr# -> [Char] (**)
- unpackNBytes#, -- :: Addr# -> Int# -> [Char] (**)
- unpackFoldrCString#, -- (**)
- unpackAppendCString#, -- (**)
+ packCString#, -- :: [Char] -> ByteArray# (**)
+ unpackCString,
+ unpackCString#, -- :: Addr# -> [Char] (**)
+ unpackNBytes#, -- :: Addr# -> Int# -> [Char] (**)
+ unpackFoldrCString#, -- (**)
+ unpackAppendCString#, -- (**)
)
- where
+ where
import GHC.Base
import GHC.Err ( error )
import GHC.Num
import GHC.Ptr
-data ByteArray ix = ByteArray ix ix ByteArray#
+data ByteArray ix = ByteArray ix ix ByteArray#
data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
unpackCString :: Ptr a -> [Char]
unpackCString a@(Ptr addr)
| a == nullPtr = []
- | otherwise = unpackCString# addr
+ | otherwise = unpackCString# addr
-packCString# :: [Char] -> ByteArray#
+packCString# :: [Char] -> ByteArray#
packCString# str = case (packString str) of { ByteArray _ _ bytes -> bytes }
packString :: [Char] -> ByteArray Int
return ()
fill_in arr_in# idx (C# c : cs) =
- write_ps_array arr_in# idx c >>
+ write_ps_array arr_in# idx c >>
fill_in arr_in# (idx +# 1#) cs
-- (Very :-) ``Specialised'' versions of some CharArray things...
-new_ps_array :: Int# -> ST s (MutableByteArray s Int)
-write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
+new_ps_array :: Int# -> ST s (MutableByteArray s Int)
+write_ps_array :: MutableByteArray s Int -> Int# -> Char# -> ST s ()
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
new_ps_array size = ST $ \ s ->
- case (newByteArray# size s) of { (# s2#, barr# #) ->
+ case (newByteArray# size s) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray bot bot barr# #) }
where
bot = error "new_ps_array"
write_ps_array (MutableByteArray _ _ barr#) n ch = ST $ \ s# ->
- case writeCharArray# barr# n ch s# of { s2# ->
+ case writeCharArray# barr# n ch s# of { s2# ->
(# s2#, () #) }
-- same as unsafeFreezeByteArray
import GHC.Show
import GHC.Num
import GHC.List ( length, replicate )
-import Numeric ( showHex )
+import Numeric ( showHex )
#include "MachDeps.h"
where
-- want 0s prefixed to pad it out to a fixed length.
pad_out ls rs =
- '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs
+ '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs
-- word2Integer :: Word# -> Integer (stolen from Word.lhs)
word2Integer w = case word2Integer# w of
- (# s, d #) -> J# s d
+ (# s, d #) -> J# s d
instance Show (FunPtr a) where
showsPrec p = showsPrec p . castFunPtrToPtr
-- #hide
module GHC.Stable
- ( StablePtr(..)
- , newStablePtr -- :: a -> IO (StablePtr a)
- , deRefStablePtr -- :: StablePtr a -> a
- , freeStablePtr -- :: StablePtr a -> IO ()
- , castStablePtrToPtr -- :: StablePtr a -> Ptr ()
- , castPtrToStablePtr -- :: Ptr () -> StablePtr a
+ ( StablePtr(..)
+ , newStablePtr -- :: a -> IO (StablePtr a)
+ , deRefStablePtr -- :: StablePtr a -> a
+ , freeStablePtr -- :: StablePtr a -> IO ()
+ , castStablePtrToPtr -- :: StablePtr a -> Ptr ()
+ , castPtrToStablePtr -- :: Ptr () -> StablePtr a
) where
import GHC.Ptr
instance Eq (StablePtr a) where
(StablePtr sp1) == (StablePtr sp2) =
- case eqStablePtr# sp1 sp2 of
- 0# -> False
- _ -> True
+ case eqStablePtr# sp1 sp2 of
+ 0# -> False
+ _ -> True
\end{code}
-- #hide
module GHC.Storable
- ( readWideCharOffPtr
- , readIntOffPtr
- , readWordOffPtr
- , readPtrOffPtr
- , readFunPtrOffPtr
- , readFloatOffPtr
- , readDoubleOffPtr
- , readStablePtrOffPtr
- , readInt8OffPtr
- , readInt16OffPtr
- , readInt32OffPtr
- , readInt64OffPtr
- , readWord8OffPtr
- , readWord16OffPtr
- , readWord32OffPtr
- , readWord64OffPtr
- , writeWideCharOffPtr
- , writeIntOffPtr
- , writeWordOffPtr
- , writePtrOffPtr
- , writeFunPtrOffPtr
- , writeFloatOffPtr
- , writeDoubleOffPtr
- , writeStablePtrOffPtr
- , writeInt8OffPtr
- , writeInt16OffPtr
- , writeInt32OffPtr
- , writeInt64OffPtr
- , writeWord8OffPtr
- , writeWord16OffPtr
- , writeWord32OffPtr
- , writeWord64OffPtr
+ ( readWideCharOffPtr
+ , readIntOffPtr
+ , readWordOffPtr
+ , readPtrOffPtr
+ , readFunPtrOffPtr
+ , readFloatOffPtr
+ , readDoubleOffPtr
+ , readStablePtrOffPtr
+ , readInt8OffPtr
+ , readInt16OffPtr
+ , readInt32OffPtr
+ , readInt64OffPtr
+ , readWord8OffPtr
+ , readWord16OffPtr
+ , readWord32OffPtr
+ , readWord64OffPtr
+ , writeWideCharOffPtr
+ , writeIntOffPtr
+ , writeWordOffPtr
+ , writePtrOffPtr
+ , writeFunPtrOffPtr
+ , writeFloatOffPtr
+ , writeDoubleOffPtr
+ , writeStablePtrOffPtr
+ , writeInt8OffPtr
+ , writeInt16OffPtr
+ , writeInt32OffPtr
+ , writeInt64OffPtr
+ , writeWord8OffPtr
+ , writeWord16OffPtr
+ , writeWord32OffPtr
+ , writeWord64OffPtr
) where
-import GHC.Stable ( StablePtr(..) )
+import GHC.Stable ( StablePtr(..) )
import GHC.Int
import GHC.Word
import GHC.Ptr
-----------------------------------------------------------------------------
module Text.Show (
- ShowS, -- String -> String
+ ShowS, -- String -> String
Show(
- showsPrec, -- :: Int -> a -> ShowS
- show, -- :: a -> String
- showList -- :: [a] -> ShowS
+ showsPrec, -- :: Int -> a -> ShowS
+ show, -- :: a -> String
+ showList -- :: [a] -> ShowS
),
- shows, -- :: (Show a) => a -> ShowS
- showChar, -- :: Char -> ShowS
- showString, -- :: String -> ShowS
- showParen, -- :: Bool -> ShowS -> ShowS
- showListWith, -- :: (a -> ShowS) -> [a] -> ShowS
+ shows, -- :: (Show a) => a -> ShowS
+ showChar, -- :: Char -> ShowS
+ showString, -- :: String -> ShowS
+ showParen, -- :: Bool -> ShowS -> ShowS
+ showListWith, -- :: (a -> ShowS) -> [a] -> ShowS
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Show
-#endif
+#endif
-- | Show a list (using square brackets and commas), given a function
-- for showing elements.
-showListWith :: (a -> ShowS) -> [a] -> ShowS
+showListWith :: (a -> ShowS) -> [a] -> ShowS
showListWith = showList__
#ifndef __GLASGOW_HASKELL__
instance Fractional T where { \
(T x) / (T y) = T (x / y) ; \
recip (T x) = T (recip x) ; \
- fromRational r = T (fromRational r) }
+ fromRational r = T (fromRational r) }
#define INSTANCE_FLOATING(T) \
instance Floating T where { \
#define INSTANCE_READ(T,B) \
instance Read T where { \
- readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
- readList = unsafeCoerce# (readList :: ReadS [B]); }
+ readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
+ readList = unsafeCoerce# (readList :: ReadS [B]); }
#define INSTANCE_SHOW(T,B) \
instance Show T where { \
- showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
- show = unsafeCoerce# (show :: B -> String); \
- showList = unsafeCoerce# (showList :: [B] -> ShowS); }
+ showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
+ show = unsafeCoerce# (show :: B -> String); \
+ showList = unsafeCoerce# (showList :: [B] -> ShowS); }
#endif /* __GLASGOW_HASKELL__ */
projects / ghc-base.git / commitdiff