[Haskell-cafe] Re: Detecting system endianness
Maurício
briqueabraque at yahoo.com
Thu Dec 18 19:18:37 EST 2008
I actually don't need a pure function, IO
is OK. I'll try something in these lines.
It doesn't build yet, with an error message
I'll probably take a few months to understand:
Couldn't match expected type
`forall a. (Storable a) => a -> IO a'
against inferred type `a -> IO a'
Thanks,
Maurício
-----
import Control.Monad ;
import Foreign ;
import Foreign.C ;
type CUInt16 = CUShort ; type CUInt8 = CChar ;
littleEndianToHost,hostToLittleEndian
:: forall a. (Storable a ) => a -> IO a ;
(littleEndianToHost,hostToLittleEndian) =
(f,f) where {
f :: forall a. ( Storable a ) => a -> IO a ;
f a = with ( 0x0102 :: CUInt16 ) $ \p -> do {
firstByte <- peek ( castPtr p :: Ptr CUInt8 ) ;
littleEndian <- return $ firstByte == 0x02 ;
halfSize <- return $ div ( alignment a ) 2;
reverse <- with a $ \val ->
zipWithM (swapByte (castPtr val :: Ptr CUInt8))
[0..halfSize-1] [halfSize..2*halfSize-1]
>> peek val ;
return $ if littleEndian then a else reverse ;
} ;
swapByte p n1 n2 = do {
v1 <- peekElemOff p n1 ;
v2 <- peekElemOff p n2 ;
pokeElemOff p n1 v2 ;
pokeElemOff p n2 v1
} >> return () }
-----
> On Thursday 18 December 2008 13:40:47 Ryan Ingram wrote:
>> Actually, this is probably safer:
>>
>> import Foreign.Marshal.Alloc
>> import Foreign.Ptr
>> import Foreign.Storable
>> import Data.Word
>> import System.IO.Unsafe
>>
>> endianCheck = unsafePerformIO $ alloca $ \p -> poke p (0x01020304 ::
>> Word32) >> peek (castPtr p :: Ptr Word8)
>>
>> littleEndian = endianCheck == 4
>> bigEndian = endianCheck == 1
>>
>> (...)
More information about the Haskell-Cafe
mailing list