From: chak <unknown>
Date: Mon, 4 Feb 2002 09:05:46 +0000 (+0000)
Subject: [project @ 2002-02-04 09:05:45 by chak]
X-Git-Tag: Approximately_9120_patches~181
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f539427ba1a13e672c6057dfa25c17ae93627d09

[project @ 2002-02-04 09:05:45 by chak]
Conformed the FFI libraries to meet the FFI Addendum 1.0 specification (except
hs_init() and friends).
---

diff --git a/ghc/lib/std/PrelBits.lhs b/ghc/lib/std/PrelBits.lhs
index 594eb56..114ce2e 100644
--- a/ghc/lib/std/PrelBits.lhs
+++ b/ghc/lib/std/PrelBits.lhs
@@ -23,7 +23,7 @@ import PrelNum
 --     Removing all fixities is a fairly safe fix; fixing the "one fixity
 --     per symbol per program" limitation in Hugs would take a lot longer.
 #ifndef __HUGS__
-infixl 8 `shift`, `rotate`
+infixl 8 `shift`, `rotate`, `shiftL`, `shiftR`, `rotateL`, `rotateR`
 infixl 7 .&.
 infixl 6 `xor`
 infixl 5 .|.
diff --git a/ghc/lib/std/PrelCTypes.lhs b/ghc/lib/std/PrelCTypes.lhs
index 24cc9c9..cca6eb8 100644
--- a/ghc/lib/std/PrelCTypes.lhs
+++ b/ghc/lib/std/PrelCTypes.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelCTypes.lhs,v 1.4 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelCTypes.lhs,v 1.5 2002/02/04 09:05:46 chak Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -14,13 +14,14 @@ A mapping of C types to corresponding Haskell types. A cool hack...
 module PrelCTypes
 	( -- Integral types, instances of: Eq, Ord, Num, Read, Show, Enum,
 	  -- Typeable, Storable, Bounded, Real, Integral, Bits
-	  CChar(..),    CSChar(..),  CUChar(..)
-	, CShort(..),   CUShort(..), CInt(..),    CUInt(..)
-	, CLong(..),    CULong(..),  CLLong(..),  CULLong(..)
+	  CChar(..),  CSChar(..),  CUChar(..)
+	, CShort(..), CUShort(..), CInt(..),   CUInt(..)
+	, CLong(..),  CULong(..),  CLLong(..), CULLong(..)
 
 	  -- Floating types, instances of: Eq, Ord, Num, Read, Show, Enum,
-	  -- Typeable, Storable, Real, Fractional, Floating, RealFrac, RealFloat
-	, CFloat(..),   CDouble(..), CLDouble(..)
+	  -- Typeable, Storable, Real, Fractional, Floating, RealFrac,
+	  -- RealFloat 
+	, CFloat(..),  CDouble(..), CLDouble(..)
 	) where
 \end{code}
 
diff --git a/ghc/lib/std/PrelCTypesISO.lhs b/ghc/lib/std/PrelCTypesISO.lhs
index 6e430aa..99955c8 100644
--- a/ghc/lib/std/PrelCTypesISO.lhs
+++ b/ghc/lib/std/PrelCTypesISO.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelCTypesISO.lhs,v 1.6 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelCTypesISO.lhs,v 1.7 2002/02/04 09:05:46 chak Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -21,6 +21,7 @@ module PrelCTypesISO
 	  -- Typeable, Storable
 	, CClock(..),   CTime(..),
 
+          -- Instances of: Eq and Storable
 	, CFile,        CFpos,     CJmpBuf
 	) where
 \end{code}
@@ -60,12 +61,9 @@ INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T)
 INTEGRAL_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
 INTEGRAL_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
 
--- TODO: Instances. But which...?  :-}
-
+-- FIXME: Implement and provide instances for Eq and Storable
 data CFile = CFile
-
 data CFpos = CFpos
-
 data CJmpBuf = CJmpBuf
 
 -- C99 types which are still missing include:
diff --git a/ghc/lib/std/PrelMarshalArray.lhs b/ghc/lib/std/PrelMarshalArray.lhs
index b80b3de..6c5e89d 100644
--- a/ghc/lib/std/PrelMarshalArray.lhs
+++ b/ghc/lib/std/PrelMarshalArray.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelMarshalArray.lhs,v 1.8 2001/08/15 09:54:38 qrczak Exp $
+% $Id: PrelMarshalArray.lhs,v 1.9 2002/02/04 09:05:46 chak Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -39,11 +39,6 @@ module PrelMarshalArray (
   withArray,      -- :: Storable a =>      [a] -> (Ptr a -> IO b) -> IO b
   withArray0,     -- :: Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
 
-  -- destruction
-  --
-  destructArray,  -- :: Storable a =>         Int -> Ptr a -> IO ()
-  destructArray0, -- :: (Storable a, Eq a) => a   -> Ptr a -> IO ()
-
   -- copying (argument order: destination, source)
   --
   copyArray,      -- :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
@@ -55,7 +50,11 @@ module PrelMarshalArray (
 
   -- indexing
   --
-  advancePtr      -- :: Storable a => Ptr a -> Int -> Ptr a
+  advancePtr,     -- :: Storable a => Ptr a -> Int -> Ptr a
+
+  -- DEPRECATED: Don't use!
+  destructArray,  -- :: Storable a =>         Int -> Ptr a -> IO ()
+  destructArray0, -- :: (Storable a, Eq a) => a   -> Ptr a -> IO ()
 ) where
 
 import Monad
@@ -209,6 +208,7 @@ withArray0 marker vals f  =
 -- destruct each element of an array (in reverse order)
 --
 destructArray          :: Storable a => Int -> Ptr a -> IO ()
+{-# DEPRECATED destructArray "This function is not standards complaint" #-}
 destructArray size ptr  =
   sequence_ [destruct (ptr `advancePtr` i)
     | i <- [size-1, size-2 .. 0]]
@@ -216,6 +216,7 @@ destructArray size ptr  =
 -- like `destructArray', but a terminator indicates where the array ends
 --
 destructArray0            :: (Storable a, Eq a) => a -> Ptr a -> IO ()
+{-# DEPRECATED destructArray0 "This function is not standards complaint" #-}
 destructArray0 marker ptr  = do
   size <- lengthArray0 marker ptr
   sequence_ [destruct (ptr `advancePtr` i)
diff --git a/ghc/lib/std/PrelMarshalError.lhs b/ghc/lib/std/PrelMarshalError.lhs
index 583610f..313ec85 100644
--- a/ghc/lib/std/PrelMarshalError.lhs
+++ b/ghc/lib/std/PrelMarshalError.lhs
@@ -1,7 +1,7 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelMarshalError.lhs,v 1.2 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelMarshalError.lhs,v 1.3 2002/02/04 09:05:46 chak Exp $
 %
-% (c) The FFI task force, 2000
+% (c) The FFI task force, [2000..2002]
 %
 
 Marshalling support: Handling of common error conditions
@@ -11,6 +11,35 @@ Marshalling support: Handling of common error conditions
 
 module PrelMarshalError (
 
+  -- I/O errors
+  -- ----------
+
+  IOErrorType,            -- abstract data type
+
+  mkIOError,	          -- :: IOErrorType 
+		          -- -> String 
+		          -- -> Maybe FilePath 
+		          -- -> Maybe Handle
+		          -- -> IOError
+  
+  alreadyExistsErrorType, -- :: IOErrorType 
+  doesNotExistErrorType,  -- :: IOErrorType 
+  alreadyInUseErrorType,  -- :: IOErrorType 
+  fullErrorType,	  -- :: IOErrorType 
+  eofErrorType,	          -- :: IOErrorType 
+  illegalOperationType,   -- :: IOErrorType 
+  permissionErrorType,    -- :: IOErrorType 
+  userErrorType,	  -- :: IOErrorType 
+
+  annotateIOError,    	  -- :: IOError 
+		      	  -- -> String 
+		      	  -- -> Maybe FilePath 
+		      	  -- -> Maybe Handle 
+		      	  -- -> IOError 
+
+  -- Result value checks
+  -- -------------------
+
   -- throw an exception on specific return values
   --
   throwIf,       -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO a
@@ -28,11 +57,57 @@ module PrelMarshalError (
 
 import PrelPtr
 import PrelIOBase
+import PrelMaybe
 import PrelNum
 import PrelBase
 
--- exported functions
--- ------------------
+
+-- I/O errors
+-- ----------
+
+-- construct an IO error
+--
+mkIOError :: IOErrorType -> String -> Maybe FilePath -> Maybe Handle -> IOError
+mkIOError errTy loc path hdl =
+  IOException $ IOError hdl errTy loc "" path
+
+-- pre-defined error types corresponding to the predicates in the standard
+-- library `IO'
+--
+alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType,
+  fullErrorType, eofErrorType, illegalOperationType, permissionErrorType, 
+  userErrorType :: IOErrorType 
+alreadyExistsErrorType = AlreadyExists
+doesNotExistErrorType  = NoSuchThing
+alreadyInUseErrorType  = ResourceBusy
+fullErrorType	       = ResourceExhausted
+eofErrorType	       = EOF
+illegalOperationType   = IllegalOperation
+permissionErrorType    = PermissionDenied
+userErrorType	       = OtherError
+
+-- add location information and possibly a path and handle to an existing I/O
+-- error 
+--
+-- * if no file path or handle is given, the corresponding value that's in the
+--   error is left unaltered
+--
+annotateIOError :: IOError 
+		-> String 
+		-> Maybe FilePath 
+		-> Maybe Handle 
+		-> IOError 
+annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = 
+  IOException (IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath))
+  where
+    Nothing `mplus` ys = ys
+    xs      `mplus` _  = xs
+annotateIOError exc				             _   _     _    = 
+  exc
+
+
+-- Result value checks
+-- -------------------
 
 -- guard an IO operation and throw an exception if the result meets the given
 -- predicate 
diff --git a/ghc/lib/std/PrelStorable.lhs b/ghc/lib/std/PrelStorable.lhs
index b5f9089..f6ce455 100644
--- a/ghc/lib/std/PrelStorable.lhs
+++ b/ghc/lib/std/PrelStorable.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelStorable.lhs,v 1.10 2001/10/03 13:57:42 simonmar Exp $
+% $Id: PrelStorable.lhs,v 1.11 2002/02/04 09:05:46 chak Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -21,6 +21,8 @@ module PrelStorable
 	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
 	     peek,           -- :: Ptr a             -> IO a
 	     poke,           -- :: Ptr a        -> a -> IO ()
+
+	     -- DEPRECATED: Don't use!
 	     destruct)       -- :: Ptr a             -> IO ()
         ) where
 \end{code}
@@ -85,6 +87,7 @@ class Storable a where
    poke ptr = pokeElemOff ptr 0
 
    destruct _ = return ()
+{-# DEPRECATED destruct "This function is not standards complaint" #-}
 \end{code}
 
 System-dependent, but rather obvious instances