{-# OPTIONS -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Foreign.C.TypesISO
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- A mapping of C types defined by the ISO C standard to corresponding Haskell
-- types. Like CTypes, this is a cool hack...
--
-----------------------------------------------------------------------------

module Foreign.C.TypesISO
	( -- Integral types, instances of: Eq, Ord, Num, Read, Show, Enum,
	  -- Typeable, Storable, Bounded, Real, Integral, Bits
	  CPtrdiff(..), CSize(..), CWchar(..), CSigAtomic(..)

	  -- Numeric types, instances of: Eq, Ord, Num, Read, Show, Enum,
	  -- Typeable, Storable
	, CClock(..),   CTime(..)

          -- Instances of: Eq and Storable
	, CFile,        CFpos,     CJmpBuf
	) where

import Data.Bits	( Bits(..) )
import Data.Int
import Data.Word
import Data.Dynamic
import Foreign.Storable

import Control.Monad
import Foreign.Ptr

 

newtype CPtrdiff = CPtrdiff Int32 deriving (Eq, Ord) ; instance Num CPtrdiff where { (CPtrdiff i) + (CPtrdiff j) = CPtrdiff (i + j) ; (CPtrdiff i) - (CPtrdiff j) = CPtrdiff (i - j) ; (CPtrdiff i) * (CPtrdiff j) = CPtrdiff (i * j) ; negate  (CPtrdiff i) = CPtrdiff (negate i) ; abs     (CPtrdiff i) = CPtrdiff (abs    i) ; signum  (CPtrdiff i) = CPtrdiff (signum i) ; fromInteger x = CPtrdiff (fromInteger x) } ; instance Read CPtrdiff where { readsPrec p s = map (\(x, t) -> (CPtrdiff x, t)) (readsPrec p s) } ; instance Show CPtrdiff where { showsPrec p (CPtrdiff x) = showsPrec p x } ; instance Enum CPtrdiff where { succ           (CPtrdiff i)             = CPtrdiff (succ i) ; pred           (CPtrdiff i)             = CPtrdiff (pred i) ; toEnum               x           = CPtrdiff (toEnum x) ; fromEnum       (CPtrdiff i)             = fromEnum i ; enumFrom       (CPtrdiff i)             = map CPtrdiff (enumFrom i) ; enumFromThen   (CPtrdiff i) (CPtrdiff j)       = map CPtrdiff (enumFromThen i j) ; enumFromTo     (CPtrdiff i) (CPtrdiff j)       = map CPtrdiff (enumFromTo i j) ; enumFromThenTo (CPtrdiff i) (CPtrdiff j) (CPtrdiff k) = map CPtrdiff (enumFromThenTo i j k) } ; instance Storable CPtrdiff where { sizeOf    (CPtrdiff x)       = sizeOf x ; alignment (CPtrdiff x)       = alignment x ; peekElemOff a i       = liftM CPtrdiff (peekElemOff (castPtr a) i) ; pokeElemOff a i (CPtrdiff x) = pokeElemOff (castPtr a) i x } ; tyConCPtrdiff = mkTyCon "CPtrdiff"; instance Typeable CPtrdiff where { typeOf _ = mkAppTy tyConCPtrdiff [] } ; ; instance Bounded CPtrdiff where { minBound = CPtrdiff minBound ; maxBound = CPtrdiff maxBound } ; instance Real CPtrdiff where { toRational (CPtrdiff i) = toRational i } ; instance Integral CPtrdiff where { (CPtrdiff i) `quot`    (CPtrdiff j) = CPtrdiff (i `quot` j) ; (CPtrdiff i) `rem`     (CPtrdiff j) = CPtrdiff (i `rem`  j) ; (CPtrdiff i) `div`     (CPtrdiff j) = CPtrdiff (i `div`  j) ; (CPtrdiff i) `mod`     (CPtrdiff j) = CPtrdiff (i `mod`  j) ; (CPtrdiff i) `quotRem` (CPtrdiff j) = let (q,r) = i `quotRem` j in (CPtrdiff q, CPtrdiff r) ; (CPtrdiff i) `divMod`  (CPtrdiff j) = let (d,m) = i `divMod`  j in (CPtrdiff d, CPtrdiff m) ; toInteger (CPtrdiff i)       = toInteger i } ; instance Bits CPtrdiff where { (CPtrdiff x) .&.     (CPtrdiff y)   = CPtrdiff (x .&.   y) ; (CPtrdiff x) .|.     (CPtrdiff y)   = CPtrdiff (x .|.   y) ; (CPtrdiff x) `xor`   (CPtrdiff y)   = CPtrdiff (x `xor` y) ; complement    (CPtrdiff x)   = CPtrdiff (complement x) ; shift         (CPtrdiff x) n = CPtrdiff (shift x n) ; rotate        (CPtrdiff x) n = CPtrdiff (rotate x n) ; bit                 n = CPtrdiff (bit n) ; setBit        (CPtrdiff x) n = CPtrdiff (setBit x n) ; clearBit      (CPtrdiff x) n = CPtrdiff (clearBit x n) ; complementBit (CPtrdiff x) n = CPtrdiff (complementBit x n) ; testBit       (CPtrdiff x) n = testBit x n ; bitSize       (CPtrdiff x)   = bitSize x ; isSigned      (CPtrdiff x)   = isSigned x }
newtype CSize = CSize Word32 deriving (Eq, Ord) ; instance Num CSize where { (CSize i) + (CSize j) = CSize (i + j) ; (CSize i) - (CSize j) = CSize (i - j) ; (CSize i) * (CSize j) = CSize (i * j) ; negate  (CSize i) = CSize (negate i) ; abs     (CSize i) = CSize (abs    i) ; signum  (CSize i) = CSize (signum i) ; fromInteger x = CSize (fromInteger x) } ; instance Read CSize where { readsPrec p s = map (\(x, t) -> (CSize x, t)) (readsPrec p s) } ; instance Show CSize where { showsPrec p (CSize x) = showsPrec p x } ; instance Enum CSize where { succ           (CSize i)             = CSize (succ i) ; pred           (CSize i)             = CSize (pred i) ; toEnum               x           = CSize (toEnum x) ; fromEnum       (CSize i)             = fromEnum i ; enumFrom       (CSize i)             = map CSize (enumFrom i) ; enumFromThen   (CSize i) (CSize j)       = map CSize (enumFromThen i j) ; enumFromTo     (CSize i) (CSize j)       = map CSize (enumFromTo i j) ; enumFromThenTo (CSize i) (CSize j) (CSize k) = map CSize (enumFromThenTo i j k) } ; instance Storable CSize where { sizeOf    (CSize x)       = sizeOf x ; alignment (CSize x)       = alignment x ; peekElemOff a i       = liftM CSize (peekElemOff (castPtr a) i) ; pokeElemOff a i (CSize x) = pokeElemOff (castPtr a) i x } ; tyConCSize = mkTyCon "CSize"; instance Typeable CSize where { typeOf _ = mkAppTy tyConCSize [] } ; ; instance Bounded CSize where { minBound = CSize minBound ; maxBound = CSize maxBound } ; instance Real CSize where { toRational (CSize i) = toRational i } ; instance Integral CSize where { (CSize i) `quot`    (CSize j) = CSize (i `quot` j) ; (CSize i) `rem`     (CSize j) = CSize (i `rem`  j) ; (CSize i) `div`     (CSize j) = CSize (i `div`  j) ; (CSize i) `mod`     (CSize j) = CSize (i `mod`  j) ; (CSize i) `quotRem` (CSize j) = let (q,r) = i `quotRem` j in (CSize q, CSize r) ; (CSize i) `divMod`  (CSize j) = let (d,m) = i `divMod`  j in (CSize d, CSize m) ; toInteger (CSize i)       = toInteger i } ; instance Bits CSize where { (CSize x) .&.     (CSize y)   = CSize (x .&.   y) ; (CSize x) .|.     (CSize y)   = CSize (x .|.   y) ; (CSize x) `xor`   (CSize y)   = CSize (x `xor` y) ; complement    (CSize x)   = CSize (complement x) ; shift         (CSize x) n = CSize (shift x n) ; rotate        (CSize x) n = CSize (rotate x n) ; bit                 n = CSize (bit n) ; setBit        (CSize x) n = CSize (setBit x n) ; clearBit      (CSize x) n = CSize (clearBit x n) ; complementBit (CSize x) n = CSize (complementBit x n) ; testBit       (CSize x) n = testBit x n ; bitSize       (CSize x)   = bitSize x ; isSigned      (CSize x)   = isSigned x }
newtype CWchar = CWchar Int32 deriving (Eq, Ord) ; instance Num CWchar where { (CWchar i) + (CWchar j) = CWchar (i + j) ; (CWchar i) - (CWchar j) = CWchar (i - j) ; (CWchar i) * (CWchar j) = CWchar (i * j) ; negate  (CWchar i) = CWchar (negate i) ; abs     (CWchar i) = CWchar (abs    i) ; signum  (CWchar i) = CWchar (signum i) ; fromInteger x = CWchar (fromInteger x) } ; instance Read CWchar where { readsPrec p s = map (\(x, t) -> (CWchar x, t)) (readsPrec p s) } ; instance Show CWchar where { showsPrec p (CWchar x) = showsPrec p x } ; instance Enum CWchar where { succ           (CWchar i)             = CWchar (succ i) ; pred           (CWchar i)             = CWchar (pred i) ; toEnum               x           = CWchar (toEnum x) ; fromEnum       (CWchar i)             = fromEnum i ; enumFrom       (CWchar i)             = map CWchar (enumFrom i) ; enumFromThen   (CWchar i) (CWchar j)       = map CWchar (enumFromThen i j) ; enumFromTo     (CWchar i) (CWchar j)       = map CWchar (enumFromTo i j) ; enumFromThenTo (CWchar i) (CWchar j) (CWchar k) = map CWchar (enumFromThenTo i j k) } ; instance Storable CWchar where { sizeOf    (CWchar x)       = sizeOf x ; alignment (CWchar x)       = alignment x ; peekElemOff a i       = liftM CWchar (peekElemOff (castPtr a) i) ; pokeElemOff a i (CWchar x) = pokeElemOff (castPtr a) i x } ; tyConCWchar = mkTyCon "CWchar"; instance Typeable CWchar where { typeOf _ = mkAppTy tyConCWchar [] } ; ; instance Bounded CWchar where { minBound = CWchar minBound ; maxBound = CWchar maxBound } ; instance Real CWchar where { toRational (CWchar i) = toRational i } ; instance Integral CWchar where { (CWchar i) `quot`    (CWchar j) = CWchar (i `quot` j) ; (CWchar i) `rem`     (CWchar j) = CWchar (i `rem`  j) ; (CWchar i) `div`     (CWchar j) = CWchar (i `div`  j) ; (CWchar i) `mod`     (CWchar j) = CWchar (i `mod`  j) ; (CWchar i) `quotRem` (CWchar j) = let (q,r) = i `quotRem` j in (CWchar q, CWchar r) ; (CWchar i) `divMod`  (CWchar j) = let (d,m) = i `divMod`  j in (CWchar d, CWchar m) ; toInteger (CWchar i)       = toInteger i } ; instance Bits CWchar where { (CWchar x) .&.     (CWchar y)   = CWchar (x .&.   y) ; (CWchar x) .|.     (CWchar y)   = CWchar (x .|.   y) ; (CWchar x) `xor`   (CWchar y)   = CWchar (x `xor` y) ; complement    (CWchar x)   = CWchar (complement x) ; shift         (CWchar x) n = CWchar (shift x n) ; rotate        (CWchar x) n = CWchar (rotate x n) ; bit                 n = CWchar (bit n) ; setBit        (CWchar x) n = CWchar (setBit x n) ; clearBit      (CWchar x) n = CWchar (clearBit x n) ; complementBit (CWchar x) n = CWchar (complementBit x n) ; testBit       (CWchar x) n = testBit x n ; bitSize       (CWchar x)   = bitSize x ; isSigned      (CWchar x)   = isSigned x }
newtype CSigAtomic = CSigAtomic Int32 deriving (Eq, Ord) ; instance Num CSigAtomic where { (CSigAtomic i) + (CSigAtomic j) = CSigAtomic (i + j) ; (CSigAtomic i) - (CSigAtomic j) = CSigAtomic (i - j) ; (CSigAtomic i) * (CSigAtomic j) = CSigAtomic (i * j) ; negate  (CSigAtomic i) = CSigAtomic (negate i) ; abs     (CSigAtomic i) = CSigAtomic (abs    i) ; signum  (CSigAtomic i) = CSigAtomic (signum i) ; fromInteger x = CSigAtomic (fromInteger x) } ; instance Read CSigAtomic where { readsPrec p s = map (\(x, t) -> (CSigAtomic x, t)) (readsPrec p s) } ; instance Show CSigAtomic where { showsPrec p (CSigAtomic x) = showsPrec p x } ; instance Enum CSigAtomic where { succ           (CSigAtomic i)             = CSigAtomic (succ i) ; pred           (CSigAtomic i)             = CSigAtomic (pred i) ; toEnum               x           = CSigAtomic (toEnum x) ; fromEnum       (CSigAtomic i)             = fromEnum i ; enumFrom       (CSigAtomic i)             = map CSigAtomic (enumFrom i) ; enumFromThen   (CSigAtomic i) (CSigAtomic j)       = map CSigAtomic (enumFromThen i j) ; enumFromTo     (CSigAtomic i) (CSigAtomic j)       = map CSigAtomic (enumFromTo i j) ; enumFromThenTo (CSigAtomic i) (CSigAtomic j) (CSigAtomic k) = map CSigAtomic (enumFromThenTo i j k) } ; instance Storable CSigAtomic where { sizeOf    (CSigAtomic x)       = sizeOf x ; alignment (CSigAtomic x)       = alignment x ; peekElemOff a i       = liftM CSigAtomic (peekElemOff (castPtr a) i) ; pokeElemOff a i (CSigAtomic x) = pokeElemOff (castPtr a) i x } ; tyConCSigAtomic = mkTyCon "CSigAtomic"; instance Typeable CSigAtomic where { typeOf _ = mkAppTy tyConCSigAtomic [] } ; ; instance Bounded CSigAtomic where { minBound = CSigAtomic minBound ; maxBound = CSigAtomic maxBound } ; instance Real CSigAtomic where { toRational (CSigAtomic i) = toRational i } ; instance Integral CSigAtomic where { (CSigAtomic i) `quot`    (CSigAtomic j) = CSigAtomic (i `quot` j) ; (CSigAtomic i) `rem`     (CSigAtomic j) = CSigAtomic (i `rem`  j) ; (CSigAtomic i) `div`     (CSigAtomic j) = CSigAtomic (i `div`  j) ; (CSigAtomic i) `mod`     (CSigAtomic j) = CSigAtomic (i `mod`  j) ; (CSigAtomic i) `quotRem` (CSigAtomic j) = let (q,r) = i `quotRem` j in (CSigAtomic q, CSigAtomic r) ; (CSigAtomic i) `divMod`  (CSigAtomic j) = let (d,m) = i `divMod`  j in (CSigAtomic d, CSigAtomic m) ; toInteger (CSigAtomic i)       = toInteger i } ; instance Bits CSigAtomic where { (CSigAtomic x) .&.     (CSigAtomic y)   = CSigAtomic (x .&.   y) ; (CSigAtomic x) .|.     (CSigAtomic y)   = CSigAtomic (x .|.   y) ; (CSigAtomic x) `xor`   (CSigAtomic y)   = CSigAtomic (x `xor` y) ; complement    (CSigAtomic x)   = CSigAtomic (complement x) ; shift         (CSigAtomic x) n = CSigAtomic (shift x n) ; rotate        (CSigAtomic x) n = CSigAtomic (rotate x n) ; bit                 n = CSigAtomic (bit n) ; setBit        (CSigAtomic x) n = CSigAtomic (setBit x n) ; clearBit      (CSigAtomic x) n = CSigAtomic (clearBit x n) ; complementBit (CSigAtomic x) n = CSigAtomic (complementBit x n) ; testBit       (CSigAtomic x) n = testBit x n ; bitSize       (CSigAtomic x)   = bitSize x ; isSigned      (CSigAtomic x)   = isSigned x }

{-# RULES
"fromIntegral/a->CPtrdiff"   fromIntegral = \x -> CPtrdiff   (fromIntegral x)
"fromIntegral/a->CSize"      fromIntegral = \x -> CSize      (fromIntegral x)
"fromIntegral/a->CWchar"     fromIntegral = \x -> CWchar     (fromIntegral x)
"fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x)

"fromIntegral/CPtrdiff->a"   fromIntegral = \(CPtrdiff   x) -> fromIntegral x
"fromIntegral/CSize->a"      fromIntegral = \(CSize      x) -> fromIntegral x
"fromIntegral/CWchar->a"     fromIntegral = \(CWchar     x) -> fromIntegral x
"fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x
 #-}

newtype CClock = CClock Word32 deriving (Eq, Ord) ; instance Num CClock where { (CClock i) + (CClock j) = CClock (i + j) ; (CClock i) - (CClock j) = CClock (i - j) ; (CClock i) * (CClock j) = CClock (i * j) ; negate  (CClock i) = CClock (negate i) ; abs     (CClock i) = CClock (abs    i) ; signum  (CClock i) = CClock (signum i) ; fromInteger x = CClock (fromInteger x) } ; instance Read CClock where { readsPrec p s = map (\(x, t) -> (CClock x, t)) (readsPrec p s) } ; instance Show CClock where { showsPrec p (CClock x) = showsPrec p x } ; instance Enum CClock where { succ           (CClock i)             = CClock (succ i) ; pred           (CClock i)             = CClock (pred i) ; toEnum               x           = CClock (toEnum x) ; fromEnum       (CClock i)             = fromEnum i ; enumFrom       (CClock i)             = map CClock (enumFrom i) ; enumFromThen   (CClock i) (CClock j)       = map CClock (enumFromThen i j) ; enumFromTo     (CClock i) (CClock j)       = map CClock (enumFromTo i j) ; enumFromThenTo (CClock i) (CClock j) (CClock k) = map CClock (enumFromThenTo i j k) } ; instance Storable CClock where { sizeOf    (CClock x)       = sizeOf x ; alignment (CClock x)       = alignment x ; peekElemOff a i       = liftM CClock (peekElemOff (castPtr a) i) ; pokeElemOff a i (CClock x) = pokeElemOff (castPtr a) i x } ; tyConCClock = mkTyCon "CClock"; instance Typeable CClock where { typeOf _ = mkAppTy tyConCClock [] } ; ; instance Bounded CClock where { minBound = CClock minBound ; maxBound = CClock maxBound } ; instance Real CClock where { toRational (CClock i) = toRational i } ; instance Integral CClock where { (CClock i) `quot`    (CClock j) = CClock (i `quot` j) ; (CClock i) `rem`     (CClock j) = CClock (i `rem`  j) ; (CClock i) `div`     (CClock j) = CClock (i `div`  j) ; (CClock i) `mod`     (CClock j) = CClock (i `mod`  j) ; (CClock i) `quotRem` (CClock j) = let (q,r) = i `quotRem` j in (CClock q, CClock r) ; (CClock i) `divMod`  (CClock j) = let (d,m) = i `divMod`  j in (CClock d, CClock m) ; toInteger (CClock i)       = toInteger i } ; instance Bits CClock where { (CClock x) .&.     (CClock y)   = CClock (x .&.   y) ; (CClock x) .|.     (CClock y)   = CClock (x .|.   y) ; (CClock x) `xor`   (CClock y)   = CClock (x `xor` y) ; complement    (CClock x)   = CClock (complement x) ; shift         (CClock x) n = CClock (shift x n) ; rotate        (CClock x) n = CClock (rotate x n) ; bit                 n = CClock (bit n) ; setBit        (CClock x) n = CClock (setBit x n) ; clearBit      (CClock x) n = CClock (clearBit x n) ; complementBit (CClock x) n = CClock (complementBit x n) ; testBit       (CClock x) n = testBit x n ; bitSize       (CClock x)   = bitSize x ; isSigned      (CClock x)   = isSigned x }
newtype CTime = CTime Int32 deriving (Eq, Ord) ; instance Num CTime where { (CTime i) + (CTime j) = CTime (i + j) ; (CTime i) - (CTime j) = CTime (i - j) ; (CTime i) * (CTime j) = CTime (i * j) ; negate  (CTime i) = CTime (negate i) ; abs     (CTime i) = CTime (abs    i) ; signum  (CTime i) = CTime (signum i) ; fromInteger x = CTime (fromInteger x) } ; instance Read CTime where { readsPrec p s = map (\(x, t) -> (CTime x, t)) (readsPrec p s) } ; instance Show CTime where { showsPrec p (CTime x) = showsPrec p x } ; instance Enum CTime where { succ           (CTime i)             = CTime (succ i) ; pred           (CTime i)             = CTime (pred i) ; toEnum               x           = CTime (toEnum x) ; fromEnum       (CTime i)             = fromEnum i ; enumFrom       (CTime i)             = map CTime (enumFrom i) ; enumFromThen   (CTime i) (CTime j)       = map CTime (enumFromThen i j) ; enumFromTo     (CTime i) (CTime j)       = map CTime (enumFromTo i j) ; enumFromThenTo (CTime i) (CTime j) (CTime k) = map CTime (enumFromThenTo i j k) } ; instance Storable CTime where { sizeOf    (CTime x)       = sizeOf x ; alignment (CTime x)       = alignment x ; peekElemOff a i       = liftM CTime (peekElemOff (castPtr a) i) ; pokeElemOff a i (CTime x) = pokeElemOff (castPtr a) i x } ; tyConCTime = mkTyCon "CTime"; instance Typeable CTime where { typeOf _ = mkAppTy tyConCTime [] } ; ; instance Bounded CTime where { minBound = CTime minBound ; maxBound = CTime maxBound } ; instance Real CTime where { toRational (CTime i) = toRational i } ; instance Integral CTime where { (CTime i) `quot`    (CTime j) = CTime (i `quot` j) ; (CTime i) `rem`     (CTime j) = CTime (i `rem`  j) ; (CTime i) `div`     (CTime j) = CTime (i `div`  j) ; (CTime i) `mod`     (CTime j) = CTime (i `mod`  j) ; (CTime i) `quotRem` (CTime j) = let (q,r) = i `quotRem` j in (CTime q, CTime r) ; (CTime i) `divMod`  (CTime j) = let (d,m) = i `divMod`  j in (CTime d, CTime m) ; toInteger (CTime i)       = toInteger i } ; instance Bits CTime where { (CTime x) .&.     (CTime y)   = CTime (x .&.   y) ; (CTime x) .|.     (CTime y)   = CTime (x .|.   y) ; (CTime x) `xor`   (CTime y)   = CTime (x `xor` y) ; complement    (CTime x)   = CTime (complement x) ; shift         (CTime x) n = CTime (shift x n) ; rotate        (CTime x) n = CTime (rotate x n) ; bit                 n = CTime (bit n) ; setBit        (CTime x) n = CTime (setBit x n) ; clearBit      (CTime x) n = CTime (clearBit x n) ; complementBit (CTime x) n = CTime (complementBit x n) ; testBit       (CTime x) n = testBit x n ; bitSize       (CTime x)   = bitSize x ; isSigned      (CTime x)   = isSigned x }

-- 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:
-- intptr_t, uintptr_t, intmax_t, uintmax_t, wint_t, wctrans_t, wctype_t

