SysArray.hs

{-# OPTIONS -fglasgow-exts #-}
module Data.Array.SysArray
         ( SysArray           -- abstract. Instances: Eq, Show
	 , mkSysArray         -- :: Word32 -> Ptr e -> Bool -> SysArray e
         , peekSysArrayElem   -- :: (Storable e) => SysArray e -> Word32 -> IO e
         , pokeSysArrayElem   -- :: (Storable e) => SysArray e -> Word32 -> e -> IO ()
         , sysArraySize       -- :: SysArray e -> Word32
	 , sysArrayIsReadOnly -- :: SysArray e -> Bool
 	 , ptrFromSysArray    -- :: (Storable e) => SysArray e -> Ptr e
         ) where

import Foreign
import Foreign.C()

-- something like StorableArray
-- lower bound implicitly 0
-- upper bound explicit
data SysArray e = SysArray Word32 !(Ptr e) Bool
    deriving (Eq,Show)

mkSysArray :: Word32 -> Ptr elt -> Bool -> SysArray elt
mkSysArray u p ro = SysArray u p ro

-- but *not* an instance of MArray, which does its own allocation
--  via newArray or newArray_
-- also not an instance of IArray, which has more cruft than we 
--  need

validSysArrayNdx :: (Storable e) => SysArray e -> Word32 -> Bool
validSysArrayNdx (SysArray u _ _) ndx = 0 <= ndx && ndx < u

ptrFromSysArray :: (Storable e) => SysArray e -> Ptr e
ptrFromSysArray (SysArray _ ptr _) = ptr

sysArraySize :: SysArray e -> Word32
sysArraySize (SysArray s _ _) = s

sysArrayIsReadOnly :: SysArray e -> Bool
sysArrayIsReadOnly (SysArray _ _ ro) = ro

pokeSysArrayElem :: (Storable e) => SysArray e -> Word32 -> e -> IO ()
pokeSysArrayElem sarr ndx v
   -- if we didn't check mode, likely to segfault
 | (not isRO && validSysArrayNdx sarr ndx) =
   pokeElemOff ptr (fromIntegral ndx) v
 | otherwise = 
   fail ("pokeSysArrayElem: illegal op/index " ++ show (ndx,isRO,(0::Integer,sysArraySize sarr)))
   where isRO = sysArrayIsReadOnly sarr
         ptr = ptrFromSysArray sarr

peekSysArrayElem :: (Storable e) => SysArray e -> Word32 -> IO e
peekSysArrayElem sarr ndx
 | validSysArrayNdx sarr ndx = peekElemOff (ptrFromSysArray sarr) (fromIntegral ndx)
 | otherwise = fail ("peekSysArrayElem: index out of bounds " ++ show (ndx,(0::Integer,sysArraySize sarr)))