\end{code}
#ifndef __HUGS__
-
-Standard instances for @Handle@:
-
-\begin{code}
-instance Eq IOError where
- (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
- e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
-
-instance Eq Handle where
- (Handle h1) == (Handle h2) = h1 == h2
-
---Type declared in IOHandle, instance here because it depends on Eq.Handle
-instance Eq HandlePosn where
- (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
-
--- Type declared in IOBase, instance here because it
--- depends on PrelRead.(Read Maybe) instance.
-instance Read BufferMode where
- readsPrec _ =
- readParen False
- (\r -> let lr = lex r
- in
- [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
- [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
- [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
- (mb, rest2) <- reads rest1])
-
-\end{code}
-
%*********************************************************
%* *
\subsection{Simple input operations}
plusAddr (A# addr) (I# off) = A# (int2Addr# (addr2Int# addr +# off))
instance CCallable Addr
-instance CCallable Addr#
instance CReturnable Addr
instance CCallable Word
-instance CCallable Word#
instance CReturnable Word
wordToInt :: Word -> Int
#else
data Word64 = W64# Word64# --deriving (Eq, Ord) -- Glasgow extension
data Int64 = I64# Int64# --deriving (Eq, Ord) -- Glasgow extension
-
-instance CCallable Word64#
-instance CCallable Int64#
#endif
instance CCallable Word64
data Ix ix => MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
instance CCallable (MutableByteArray s ix)
-instance CCallable (MutableByteArray# s)
-
instance CCallable (ByteArray ix)
-instance CCallable ByteArray#
data MutableVar s a = MutableVar (MutVar# s a)
(S# i) /= (J# s d) = cmpIntegerInt# s d i /=# 0#
(J# s d) /= (S# i) = cmpIntegerInt# s d i /=# 0#
(J# s1 d1) /= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#
+
+instance Ord Integer where
+ (S# i) <= (S# j) = i <=# j
+ (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
+ (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
+ (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
+
+ (S# i) > (S# j) = i ># j
+ (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
+ (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
+ (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
+
+ (S# i) < (S# j) = i <# j
+ (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
+ (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
+ (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
+
+ (S# i) >= (S# j) = i >=# j
+ (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
+ (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
+ (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
+
+ compare (S# i) (S# j)
+ | i ==# j = EQ
+ | i <=# j = LT
+ | otherwise = GT
+ compare (J# s d) (S# i)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# <# 0# then LT else
+ if res# ># 0# then GT else EQ
+ }
+ compare (S# i) (J# s d)
+ = case cmpIntegerInt# s d i of { res# ->
+ if res# ># 0# then LT else
+ if res# <# 0# then GT else EQ
+ }
+ compare (J# s1 d1) (J# s2 d2)
+ = case cmpInteger# s1 d1 s2 d2 of { res# ->
+ if res# <# 0# then LT else
+ if res# ># 0# then GT else EQ
+ }
\end{code}
\begin{code}
instance CCallable Char
-instance CCallable Char#
instance CReturnable Char
instance CCallable Int
-instance CCallable Int#
instance CReturnable Int
-- DsCCall knows how to pass strings...
instance CCallable [Char]
instance CCallable Float
-instance CCallable Float#
instance CReturnable Float
instance CCallable Double
-instance CCallable Double#
instance CReturnable Double
instance CReturnable () -- Why, exactly?
\begin{code}
--Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
-instance Eq (MVar a) where
- (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
-
newEmptyMVar :: IO (MVar a)
newEmptyMVar = IO $ \ s# ->
case makeForeignObj# obj s# of
(# s1#, fo# #) -> (# s1#, ForeignObj fo# #) )
-eqForeignObj :: ForeignObj -> ForeignObj -> Bool
--makeForeignObj :: Addr -> Addr -> IO ForeignObj
writeForeignObj :: ForeignObj -> Addr -> IO ()
writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
case writeForeignObj# fo# datum# s# of { s1# -> (# s1#, () #) } )
-
-eqForeignObj mp1 mp2
- = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
-
-foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
-
-instance Eq ForeignObj where
- p == q = eqForeignObj p q
- p /= q = not (eqForeignObj p q)
#endif /* !__PARALLEL_HASKELL__ */
\end{code}
%*********************************************************
\begin{code}
-foreign import "libHS_cbits" "freeStdFileObject"
+foreign import "libHS_cbits" "freeStdFileObject" unsafe
freeStdFileObject :: FILE_OBJECT -> IO ()
-foreign import "libHS_cbits" "freeFileObject"
+foreign import "libHS_cbits" "freeFileObject" unsafe
freeFileObject :: FILE_OBJECT -> IO ()
\end{code}
-- [what's the winning argument for it not being strong? --sof]
HandlePosition
+instance Eq HandlePosn where
+ (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
+
-- HandlePosition is the Haskell equivalent of POSIX' off_t.
-- We represent it as an Integer on the Haskell side, but
-- cheat slightly in that hGetPosn calls upon a C helper
% -----------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.13 1999/09/19 19:12:41 sof Exp $
+% $Id: PrelIOBase.lhs,v 1.14 1999/11/22 15:55:51 simonmar Exp $
%
% (c) The AQUA Project, Glasgow University, 1994-1998
%
String -- location
String -- error type specific information.
+instance Eq IOError where
+ (IOError h1 e1 loc1 str1) == (IOError h2 e2 loc2 str2) =
+ e1==e2 && str1==str2 && h1==h2 && loc1 == loc2
data IOErrorType
= AlreadyExists | HardwareFault
-}
data MVar a = MVar (MVar# RealWorld a)
+-- pull in Eq (Mvar a) too, to avoid PrelConc being an orphan-instance module
+instance Eq (MVar a) where
+ (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+
{-
Double sigh - ForeignObj is needed here too to break a cycle.
-}
data ForeignObj = ForeignObj ForeignObj# -- another one
instance CCallable ForeignObj
-instance CCallable ForeignObj#
+
+eqForeignObj :: ForeignObj -> ForeignObj -> Bool
+eqForeignObj mp1 mp2
+ = unsafePerformIO (primEqForeignObj mp1 mp2) /= (0::Int)
+
+foreign import "eqForeignObj" unsafe primEqForeignObj :: ForeignObj -> ForeignObj -> IO Int
+
+instance Eq ForeignObj where
+ p == q = eqForeignObj p q
+ p /= q = not (eqForeignObj p q)
#endif /* ndef __HUGS__ */
#if defined(__CONCURRENT_HASKELL__)
newtype Handle = Handle (MutableVar RealWorld Handle__)
#endif
+instance Eq Handle where
+ (Handle h1) == (Handle h2) = h1 == h2
+
{-
A Handle is represented by (a reference to) a record
containing the state of the I/O port/device. We record
%*********************************************************
\begin{code}
-instance Ord Integer where
- (S# i) <= (S# j) = i <=# j
- (J# s d) <= (S# i) = cmpIntegerInt# s d i <=# 0#
- (S# i) <= (J# s d) = cmpIntegerInt# s d i >=# 0#
- (J# s1 d1) <= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#
-
- (S# i) > (S# j) = i ># j
- (J# s d) > (S# i) = cmpIntegerInt# s d i ># 0#
- (S# i) > (J# s d) = cmpIntegerInt# s d i <# 0#
- (J# s1 d1) > (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#
-
- (S# i) < (S# j) = i <# j
- (J# s d) < (S# i) = cmpIntegerInt# s d i <# 0#
- (S# i) < (J# s d) = cmpIntegerInt# s d i ># 0#
- (J# s1 d1) < (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#
-
- (S# i) >= (S# j) = i >=# j
- (J# s d) >= (S# i) = cmpIntegerInt# s d i >=# 0#
- (S# i) >= (J# s d) = cmpIntegerInt# s d i <=# 0#
- (J# s1 d1) >= (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#
-
- compare (S# i) (S# j)
- | i ==# j = EQ
- | i <=# j = LT
- | otherwise = GT
- compare (J# s d) (S# i)
- = case cmpIntegerInt# s d i of { res# ->
- if res# <# 0# then LT else
- if res# ># 0# then GT else EQ
- }
- compare (S# i) (J# s d)
- = case cmpIntegerInt# s d i of { res# ->
- if res# ># 0# then LT else
- if res# <# 0# then GT else EQ
- }
- compare (J# s1 d1) (J# s2 d2)
- = case cmpInteger# s1 d1 s2 d2 of { res# ->
- if res# <# 0# then LT else
- if res# ># 0# then GT else EQ
- }
-
toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
toBig i@(J# _ _) = i
"enumDeltaInteger" enumDeltaIntegerFB (:) = enumDeltaIntegerList
"enumDeltaToInteger" enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
#-}
+\end{code}
-------------------------------------------------------------------------
+%*********************************************************
+%* *
+\subsection{Show code for Integers}
+%* *
+%*********************************************************
+\begin{code}
instance Show Integer where
showsPrec x = showSignedInteger x
showList = showList__ (showsPrec 0)
-
showSignedInteger :: Int -> Integer -> ShowS
showSignedInteger p n r
| n < 0 && p > 6 = '(':jtos n (')':r)
import PrelBase
import Monad
--- needed for readIO.
-import PrelIOBase ( IO, userError )
+-- needed for readIO and instance Read Buffermode
+import PrelIOBase ( IO, userError, BufferMode(..) )
import PrelException ( ioError )
\end{code}
#endif
\end{code}
+
+%*********************************************************
+%* *
+\subsection{Reading BufferMode}
+%* *
+%*********************************************************
+
+This instance decl is here rather than somewhere more appropriate in
+order that we can avoid both orphan-instance modules and recursive
+dependencies.
+
+\begin{code}
+instance Read BufferMode where
+ readsPrec _ =
+ readParen False
+ (\r -> let lr = lex r
+ in
+ [(NoBuffering, rest) | ("NoBuffering", rest) <- lr] ++
+ [(LineBuffering,rest) | ("LineBuffering",rest) <- lr] ++
+ [(BlockBuffering mb,rest2) | ("BlockBuffering",rest1) <- lr,
+ (mb, rest2) <- reads rest1])
+
+\end{code}
(C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
\end{code}
-
-
%*********************************************************
%* *
\subsection{Character stuff}
projects / ghc-hetmet.git / commitdiff