Time.icl 4.31 KB
Newer Older
1
implementation module System.Time
2

3
import StdString, StdArray, StdClass, StdOverloaded, StdInt, StdMisc
4
import System._Pointer
5 6 7 8
import System._WinBase
import Data.Integer
import Data.List
from Data.Func import $
Camil Staps's avatar
oops  
Camil Staps committed
9
import Text
10

11 12
import code from library "msvcrt.txt"

13 14 15
//String buffer size
MAXBUF :== 256

16 17 18 19 20 21 22 23
instance == Timestamp
where
	(==) (Timestamp t1) (Timestamp t2) = t1 == t2
	
instance < Timestamp
where
	(<) (Timestamp t1) (Timestamp t2) = t1 < t2 

24 25
instance toString Tm
where
26
	toString tm = trim (derefString (toStringTmC (packTm tm)))
27 28 29
	where
		toStringTmC :: !{#Int} -> Pointer
		toStringTmC a0 = code {
Steffen Michels's avatar
Steffen Michels committed
30
			ccall asctime "A:I"
31
		}
32
instance toString Timestamp
33
where
34 35
	toString (Timestamp t) 
	| t < 0 = abort "System.Time: Timestamp cannot be negative" 
36
	= trim (derefString (toStringTimeC (packInt t)))
37 38 39
	where	
		toStringTimeC :: !{#Int} -> Pointer
		toStringTimeC a0 = code {
Steffen Michels's avatar
Steffen Michels committed
40
			ccall ctime "A:I"
41 42 43 44
		}
instance toString Clock
where
	toString (Clock c) = toString c
45 46 47
instance toInt Timestamp
where
	toInt (Timestamp i) = i
48 49 50 51 52 53 54 55

clock :: !*World -> (!Clock, !*World)
clock world
	# (c, world) = clockC world
	= (Clock c, world)
	where
	clockC :: !*World -> (!Int, !*World)
	clockC world = code {
Steffen Michels's avatar
Steffen Michels committed
56
		ccall clock ":I:I"
57 58
	}

59
time :: !*World -> (!Timestamp, !*World)
60 61
time world
	# (t, world)	= timeC 0 world
62
	= (Timestamp t, world)
63 64 65
	where
	timeC :: !Int !*World -> (!Int,!*World)
	timeC a0 world = code {
Steffen Michels's avatar
Steffen Michels committed
66
		ccall time "I:I:I"
67 68 69 70
	}

gmTime :: !*World -> (!Tm, !*World)
gmTime world
71
	# ((Timestamp t),world)	= time world
72
	# tm					= gmTimeC (packInt t)
73 74 75 76
	= (derefTm tm, world)

localTime :: !*World -> (!Tm, !*World)
localTime world
77
	# ((Timestamp t),world)	= time world
78
	# (tm,world)			= localTimeC (packInt t) world
79 80
	= (derefTm tm, world)

81 82 83 84 85 86 87 88
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:I"
89 90
	}

Steffen Michels's avatar
Steffen Michels committed
91 92 93 94 95 96 97 98
timeGm :: !Tm -> Timestamp
timeGm tm = Timestamp (timegmC (packTm tm))
where
	timegmC :: !{#Int} -> Int
	timegmC tm = code {
		ccall _mkgmtime "A:I"
	}

99 100
diffTime :: !Timestamp !Timestamp -> Int
diffTime (Timestamp t1) (Timestamp t2) = t1 - t2
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 {
Steffen Michels's avatar
Steffen Michels committed
110
			ccall strftime "sIsA:I:A"
111
		}
112 113 114 115 116 117 118 119 120
		
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))

121
gmTimeC :: !{#Int} -> Int
122
gmTimeC tm = code {
Steffen Michels's avatar
Steffen Michels committed
123
	ccall gmtime "A:I"
124 125 126 127
}

localTimeC :: !{#Int} !*World -> (!Int, !*World)
localTimeC tm world = code {
Steffen Michels's avatar
Steffen Michels committed
128
	ccall localtime "A:I:I"
129
}
130 131 132

//Custom deref and pack for the Tm structure
derefTm :: !Int -> Tm
133 134 135 136 137 138 139 140
derefTm tm =	{ sec	= readInt4S tm 0
				, min	= readInt4S tm 4
				, hour	= readInt4S tm 8 
				, mday	= readInt4S tm 12 
				, mon	= readInt4S tm 16
				, year	= readInt4S tm 20
				, wday	= readInt4S tm 24
				, yday	= readInt4S tm 28 
141
				, isdst	= readInt4S tm 32
142
				}
143

144
packTm :: !Tm -> {#Int}
145 146 147 148 149 150 151
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
152
				, tm.isdst
153 154 155 156
				}
				
packTm32 :: !Tm -> {#Int}
packTm32 tm = 	{ tm.sec
157 158 159 160 161 162 163
				, tm.min
				, tm.hour
				, tm.mday
				, tm.mon
				, tm.year
				, tm.wday
				, tm.yday
164
				, tm.isdst
165
				}
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
				
//Number of ticks difference between the windows and linux epoch
TICKSDIFF :== {integer_s=0,integer_a={-1240428288,2}} * TICKSPERSEC
//Number of ticks per second on windows machines
TICKSPERSEC :== {integer_s=10000000,integer_a={}}
BIGTWO :== {integer_s=2,integer_a={}}
				
nsTime :: !*World -> (!Timespec, !*World)
nsTime w
# (is, w) = GetSystemTimeAsFileTime (createArray 2 0) w
# ticks = uintToInt is.[0] + foldr ($) (uintToInt is.[1]) (repeatn 32 ((*) BIGTWO)) - TICKSDIFF
= ({Timespec | tv_sec=toInt (ticks / TICKSPERSEC), tv_nsec=toInt (ticks rem TICKSPERSEC) *100}, w)

uintToInt :: Int -> Integer
uintToInt i
| i < 0 = toInteger i + {integer_s=0,integer_a={0,1}}
= toInteger i