Commit 67a040b2 authored by panne's avatar panne
Browse files

[project @ 2004-06-13 21:03:46 by panne]

Changes related to arithmetic types:

* Renamed macros NUMERIC_FOO to ARITHMETIC_FOO to match C99-speak

* ARITHMETIC_TYPEs now have a Real instance, otherwise they are quite useless.
  Note that this differs from the FFI spec, but the spec should very probably
  changed in this respect.

* Some changes to fix the wrong assumption that CTime/CClock are integral types,
  C99 in fact guarantees only that they are arithmetic types. This has been
  accomplished by using

     realToInteger = round . realToFrac :: Real a => a -> Integer

  instead of fromIntegral for CTime/CClock. I'm not sure if we could do better,
  going via Double seems to be overkill, but I couldn't think of a better way.
  GHC could e.g. use RULES here. Improvements welcome.
parent c4ed8d8e
......@@ -154,8 +154,8 @@ INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T)
"fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x
#-}
NUMERIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
NUMERIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
-- FIXME: Implement and provide instances for Eq and Storable
data CFile = CFile
......
......@@ -64,9 +64,9 @@ getCPUTime = do
u_usec <- (#peek struct timeval,tv_usec) ru_utime :: IO CTime
s_sec <- (#peek struct timeval,tv_sec) ru_stime :: IO CTime
s_usec <- (#peek struct timeval,tv_usec) ru_stime :: IO CTime
return ((fromIntegral u_sec * 1000000 + fromIntegral u_usec +
fromIntegral s_sec * 1000000 + fromIntegral s_usec)
let realToInteger = round . realToFrac :: Real a => a -> Integer
return ((realToInteger u_sec * 1000000 + realToInteger u_usec +
realToInteger s_sec * 1000000 + realToInteger s_usec)
* 1000000)
type CRUsage = ()
......@@ -77,7 +77,8 @@ foreign import ccall unsafe getrusage :: CInt -> Ptr CRUsage -> IO CInt
times p_tms
u_ticks <- (#peek struct tms,tms_utime) p_tms :: IO CClock
s_ticks <- (#peek struct tms,tms_stime) p_tms :: IO CClock
return (( (fromIntegral u_ticks + fromIntegral s_ticks) * 1000000000000)
let realToInteger = round . realToFrac :: Real a => a -> Integer
return (( (realToInteger u_ticks + realToInteger s_ticks) * 1000000000000)
`div` fromIntegral clockTicks)
type CTms = ()
......
......@@ -632,7 +632,8 @@ withFileOrSymlinkStatus loc name f = do
modificationTime :: Ptr CStat -> IO ClockTime
modificationTime stat = do
mtime <- st_mtime stat
return (TOD (toInteger (mtime :: CTime)) 0)
let realToInteger = round . realToFrac :: Real a => a -> Integer
return (TOD (realToInteger (mtime :: CTime)) 0)
isDirectory :: Ptr CStat -> IO Bool
isDirectory stat = do
......
......@@ -105,7 +105,7 @@ import Control.Monad
#include "CTypes.h"
#if defined(HTYPE_DEV_T)
NUMERIC_TYPE(CDev,tyConCDev,"CDev",HTYPE_DEV_T)
ARITHMETIC_TYPE(CDev,tyConCDev,"CDev",HTYPE_DEV_T)
#endif
#if defined(HTYPE_INO_T)
INTEGRAL_TYPE(CIno,tyConCIno,"CIno",HTYPE_INO_T)
......@@ -139,10 +139,10 @@ INTEGRAL_TYPE(CNlink,tyConCNlink,"CNlink",HTYPE_NLINK_T)
INTEGRAL_TYPE(CUid,tyConCUid,"CUid",HTYPE_UID_T)
#endif
#if defined(HTYPE_CC_T)
NUMERIC_TYPE(CCc,tyConCCc,"CCc",HTYPE_CC_T)
ARITHMETIC_TYPE(CCc,tyConCCc,"CCc",HTYPE_CC_T)
#endif
#if defined(HTYPE_SPEED_T)
NUMERIC_TYPE(CSpeed,tyConCSpeed,"CSpeed",HTYPE_SPEED_T)
ARITHMETIC_TYPE(CSpeed,tyConCSpeed,"CSpeed",HTYPE_SPEED_T)
#endif
#if defined(HTYPE_TCFLAG_T)
INTEGRAL_TYPE(CTcflag,tyConCTcflag,"CTcflag",HTYPE_TCFLAG_T)
......
......@@ -219,19 +219,21 @@ getClockTime = do
#elif HAVE_GETTIMEOFDAY
getClockTime = do
let realToInteger = round . realToFrac :: Real a => a -> Integer
allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do
throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr
sec <- (#peek struct timeval,tv_sec) p_timeval :: IO CTime
usec <- (#peek struct timeval,tv_usec) p_timeval :: IO CTime
return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000))
return (TOD (realToInteger sec) ((realToInteger usec) * 1000000))
#elif HAVE_FTIME
getClockTime = do
let realToInteger = round . realToFrac :: Real a => a -> Integer
allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do
ftime p_timeb
sec <- (#peek struct timeb,time) p_timeb :: IO CTime
msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort
return (TOD (fromIntegral sec) (fromIntegral msec * 1000000000))
return (TOD (realToInteger sec) (fromIntegral msec * 1000000000))
#else /* use POSIX time() */
getClockTime = do
......@@ -528,8 +530,9 @@ toClockTime (CalendarTime year mon mday hour min sec psec
-- result.
--
gmtoff <- gmtoff p_tm
let res = fromIntegral t - tz + fromIntegral gmtoff
return (TOD (fromIntegral res) psec)
let realToInteger = round . realToFrac :: Real a => a -> Integer
res = realToInteger t - fromIntegral tz + fromIntegral gmtoff
return (TOD res psec)
#endif /* ! __HUGS__ */
-- -----------------------------------------------------------------------------
......
/* -----------------------------------------------------------------------------
* $Id: CTypes.h,v 1.7 2003/07/24 12:05:42 panne Exp $
* $Id: CTypes.h,v 1.8 2004/06/13 21:03:47 panne Exp $
*
* Dirty CPP hackery for CTypes/CTypesISO
*
......@@ -15,9 +15,10 @@
/* A hacked version for GHC follows the Haskell 98 version... */
#ifndef __GLASGOW_HASKELL__
#define NUMERIC_TYPE(T,C,S,B) \
#define ARITHMETIC_TYPE(T,C,S,B) \
newtype T = T B deriving (Eq, Ord) ; \
INSTANCE_NUM(T) ; \
INSTANCE_REAL(T) ; \
INSTANCE_READ(T,B) ; \
INSTANCE_SHOW(T,B) ; \
INSTANCE_ENUM(T) ; \
......@@ -25,15 +26,13 @@ INSTANCE_STORABLE(T) ; \
INSTANCE_TYPEABLE0(T,C,S) ;
#define INTEGRAL_TYPE(T,C,S,B) \
NUMERIC_TYPE(T,C,S,B) ; \
ARITHMETIC_TYPE(T,C,S,B) ; \
INSTANCE_BOUNDED(T) ; \
INSTANCE_REAL(T) ; \
INSTANCE_INTEGRAL(T) ; \
INSTANCE_BITS(T)
#define FLOATING_TYPE(T,C,S,B) \
NUMERIC_TYPE(T,C,S,B) ; \
INSTANCE_REAL(T) ; \
ARITHMETIC_TYPE(T,C,S,B) ; \
INSTANCE_FRACTIONAL(T) ; \
INSTANCE_FLOATING(T) ; \
INSTANCE_REALFRAC(T) ; \
......@@ -172,24 +171,24 @@ instance Storable T where { \
* here...
*/
#define NUMERIC_CLASSES Eq,Ord,Num,Enum,Storable
#define INTEGRAL_CLASSES Bounded,Real,Integral,Bits
#define FLOATING_CLASSES Real,Fractional,Floating,RealFrac,RealFloat
#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real
#define INTEGRAL_CLASSES Bounded,Integral,Bits
#define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat
#define NUMERIC_TYPE(T,C,S,B) \
newtype T = T B deriving (NUMERIC_CLASSES); \
#define ARITHMETIC_TYPE(T,C,S,B) \
newtype T = T B deriving (ARITHMETIC_CLASSES); \
INSTANCE_READ(T,B); \
INSTANCE_SHOW(T,B); \
INSTANCE_TYPEABLE0(T,C,S) ;
#define INTEGRAL_TYPE(T,C,S,B) \
newtype T = T B deriving (NUMERIC_CLASSES, INTEGRAL_CLASSES); \
newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \
INSTANCE_READ(T,B); \
INSTANCE_SHOW(T,B); \
INSTANCE_TYPEABLE0(T,C,S) ;
#define FLOATING_TYPE(T,C,S,B) \
newtype T = T B deriving (NUMERIC_CLASSES, FLOATING_CLASSES); \
newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \
INSTANCE_READ(T,B); \
INSTANCE_SHOW(T,B); \
INSTANCE_TYPEABLE0(T,C,S) ;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment