Time.icl 5.29 KB
Newer Older
1
implementation module System.Time
Bas Lijnse's avatar
Bas Lijnse committed
2

3
import StdString, StdArray, StdClass, StdOverloaded, StdInt, StdMisc
4
import System._Pointer, System._Posix
5
import Text
Bas Lijnse's avatar
Bas Lijnse committed
6 7 8 9

//String buffer size
MAXBUF :== 256

10 11 12 13 14 15 16 17
instance == Timestamp
where
	(==) (Timestamp t1) (Timestamp t2) = t1 == t2

instance < Timestamp
where
	(<) (Timestamp t1) (Timestamp t2) = t1 < t2

Bas Lijnse's avatar
Bas Lijnse committed
18 19
instance toString Tm
where
20
	toString tm = trim (derefString (toStringTmC (packTm tm)))
Bas Lijnse's avatar
Bas Lijnse committed
21 22 23 24 25
	where
		toStringTmC :: !{#Int} -> Pointer
		toStringTmC a0 = code {
			ccall asctime "A:p"
		}
26
instance toString Timestamp
Bas Lijnse's avatar
Bas Lijnse committed
27
where
28
	toString (Timestamp t) = trim (derefString (toStringTimeC (packInt t)))
Bas Lijnse's avatar
Bas Lijnse committed
29 30 31 32 33 34 35 36
	where	
		toStringTimeC :: !{#Int} -> Pointer
		toStringTimeC a0 = code {
			ccall ctime "A:p"
		}
instance toString Clock
where
	toString (Clock c) = toString c
37 38 39
instance toInt Timestamp
where
	toInt (Timestamp i) = i
Bas Lijnse's avatar
Bas Lijnse committed
40 41 42 43 44 45 46 47 48 49 50

clock :: !*World -> (!Clock, !*World)
clock world
	# (c, world) = clockC world
	= (Clock c, world)
	where
	clockC :: !*World -> (!Int, !*World)
	clockC world = code {
		ccall clock ":I:p"
	}

51
time :: !*World -> (!Timestamp, !*World)
Bas Lijnse's avatar
Bas Lijnse committed
52 53
time world
	# (t, world)	= timeC 0 world
54
	= (Timestamp t, world)
Bas Lijnse's avatar
Bas Lijnse committed
55 56 57 58 59 60 61 62
	where
	timeC :: !Int !*World -> (!Int,!*World)
	timeC a0 world = code {
		ccall time "I:I:p"
	}

gmTime :: !*World -> (!Tm, !*World)
gmTime world
63 64
	# ((Timestamp t),world)	= time world
	# (tm, world)			= gmTimeC (packInt t) world
Bas Lijnse's avatar
Bas Lijnse committed
65 66 67 68 69 70 71 72 73
	= (derefTm tm, world)
	where
	gmTimeC :: !{#Int} !*World -> (!Int, !*World)
	gmTimeC tm world = code {
    	ccall gmtime "A:p:p"
	}

localTime :: !*World -> (!Tm, !*World)
localTime world
74 75
	# ((Timestamp t),world)	= time world
	# (tm,world)			= localTimeC (packInt t) world
Bas Lijnse's avatar
Bas Lijnse committed
76 77 78 79 80 81 82
	= (derefTm tm, world)
	where
	localTimeC :: !{#Int} !*World -> (!Int, !*World)
	localTimeC tm world = code {
    	ccall localtime "A:p:p"
	}

83 84 85 86 87 88 89 90
mkTime :: !Tm !*World-> (!Timestamp, !*World)
mkTime tm world
	# (t, world) = mkTimeC (packTm tm) world
	= (Timestamp t, world)
where
	mkTimeC :: !{#Int} !*World -> (!Int, !*World)
	mkTimeC tm world = code {
		ccall mktime "A:I:A"
Bas Lijnse's avatar
Bas Lijnse committed
91 92
	}

93 94 95
timeGm :: !Tm -> Timestamp
timeGm tm = Timestamp (timegm (packTm tm))

96 97
diffTime :: !Timestamp !Timestamp -> Int
diffTime (Timestamp t1) (Timestamp t2) = t1 - t2
Bas Lijnse's avatar
Bas Lijnse committed
98 99 100 101 102 103 104 105 106 107 108 109

strfTime :: !String !Tm -> String
strfTime format tm 
	# buf		= createArray MAXBUF 'X'
	# (len,buf)	= strfTimeC buf MAXBUF (packString format) (packTm tm) buf
	= buf % (0, len - 1)
	where
		strfTimeC :: !{#Char} !Int !{#Char} !{#Int} !{#Char} -> (!Int,!{#Char})
		strfTimeC a0 a1 a2 a3 a4 = code {
			ccall strftime "sIsA:I:A"
		}

110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
toLocalTime :: !Timestamp !*World -> (!Tm,!*World)
toLocalTime (Timestamp t) world
    # (tm,world) = localTimeC (packInt t) world
    = (derefTm tm, world)

toGmTime :: !Timestamp -> Tm
toGmTime (Timestamp t) = derefTm (gmTimeC (packInt t))

gmTimeC :: !{#Int} -> Pointer
gmTimeC tm = code {
    ccall gmtime "A:p"
}

localTimeC :: !{#Int} !*World -> (!Pointer, !*World)
localTimeC tm world = code {
    ccall localtime "A:p:p"
}

derefTm :: !Pointer-> Tm
derefTm ptr = unpackTm (derefCharArray ptr sizeOfTm) 0
Bas Lijnse's avatar
Bas Lijnse committed
130 131

packTm :: !Tm -> {#Int}
132 133 134 135 136 137 138
packTm tm = (IF_INT_64_OR_32 packTm64 packTm32) tm

packTm64 :: !Tm -> {#Int}
packTm64 tm =   { tm.sec  + tm.min  << 32
                , tm.hour + tm.mday << 32
                , tm.mon  + tm.year << 32
                , tm.wday + tm.yday << 32
139
                , tm.isdst
140 141 142 143 144 145 146 147 148 149 150
                }

packTm32 :: !Tm -> {#Int}
packTm32 tm =   { tm.sec
                , tm.min
                , tm.hour
                , tm.mday
                , tm.mon
                , tm.year
                , tm.wday
                , tm.yday
151
                , tm.isdst
152 153 154 155 156 157 158 159 160 161 162 163
                }

unpackTm :: !{#Char} !Int -> Tm
unpackTm buf off =
	{ sec   = unpackInt4S buf (off + 0)
    , min   = unpackInt4S buf (off + 4)
	, hour  = unpackInt4S buf (off + 8)
	, mday  = unpackInt4S buf (off + 12)
	, mon   = unpackInt4S buf (off + 16)
	, year  = unpackInt4S buf (off + 20)
	, wday  = unpackInt4S buf (off + 24)
	, yday  = unpackInt4S buf (off + 28)
164
	, isdst = unpackInt4S buf (off + 32)
165
	}
166 167 168

sizeOfTm :: Int
sizeOfTm = 36 
169 170 171 172 173

nsTime :: !*World -> (!Timespec, !*World)
nsTime w
# (p, w) = mallocSt 16 w
# (r, w) = clock_gettime 0 p w
174
//For completeness sake
175
| r <> 0 = abort "clock_gettime error: everyone should have permission to open CLOCK_REALTIME?"
176 177 178
# (tv_sec, p) = readIntP p 0
# (tv_nsec, p) = readIntP p 8
= ({Timespec | tv_sec = tv_sec, tv_nsec = tv_nsec}, freeSt p w)
179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205

timespecToStamp :: !Timespec -> Timestamp
timespecToStamp t = Timestamp t.tv_sec

timestampToSpec :: !Timestamp -> Timespec
timestampToSpec (Timestamp t) = {tv_sec=t,tv_nsec=0}

instance < Timespec
where
	(<) t1 t2
		| t1.tv_sec == t2.tv_sec = t1.tv_nsec < t2.tv_nsec
		= t1.tv_sec < t2.tv_sec

instance + Timespec
where
	(+) t1 t2 = let tv_nsec = t1.tv_nsec + t2.tv_nsec in
		{ tv_sec  = t1.tv_sec + t2.tv_sec + tv_nsec / 1000000000
		, tv_nsec = tv_nsec rem 1000000000
		}

instance - Timespec
where
	(-) t1 t2
		# tv_nsec = t1.tv_nsec - t2.tv_nsec
		| tv_nsec < 0
			= {tv_sec = t1.tv_sec - t2.tv_sec - 1, tv_nsec = 1000000000 - tv_nsec}
			= {tv_sec = t1.tv_sec - t2.tv_sec - 1, tv_nsec = tv_nsec}
206 207 208

instance zero Timespec
where zero = {tv_sec=0, tv_nsec=0}
209 210 211 212 213 214 215 216 217

nanoSleep :: !Timespec !*w -> *w
nanoSleep ts w
# (p, w) = mallocSt 16 w
# p = writeInt p 0 ts.tv_sec
# p = writeInt p 8 ts.tv_nsec
# (res, w) = nanosleep p 0 w
| res <> 0 = abort "nanosleep error: did I just got interrupted?"
= freeSt p w