1(* 2 Title: Standard Basis Library: Time Signature and structure. 3 Author: David Matthews 4 Copyright David Matthews 2000, 2005, 2017, 2019 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18*) 19 20 21signature TIME = 22sig 23 eqtype time 24 exception Time 25 val zeroTime : time 26 val fromReal : LargeReal.real -> time 27 val toReal : time -> LargeReal.real 28 val toSeconds : time -> LargeInt.int 29 val toMilliseconds : time -> LargeInt.int 30 val toMicroseconds : time -> LargeInt.int 31 val toNanoseconds : time -> LargeInt.int 32 val fromSeconds : LargeInt.int -> time 33 val fromMilliseconds : LargeInt.int -> time 34 val fromMicroseconds : LargeInt.int -> time 35 val fromNanoseconds : LargeInt.int -> time 36 val + : time * time -> time 37 val - : time * time -> time 38 val compare : time * time -> General.order 39 val < : time * time -> bool 40 val <= : time * time -> bool 41 val > : time * time -> bool 42 val >= : time * time -> bool 43 val now : unit -> time 44 val fmt : int -> time -> string 45 val toString : time -> string 46 val fromString : string -> time option 47 val scan : (char, 'a) StringCvt.reader -> (time, 'a) StringCvt.reader 48end; 49 50structure Time :> TIME = 51struct 52 (* Unix and Windows both use 64 bit quantities for times. Windows 53 uses a 64-bit number of 100ns ticks, Unix uses one word of seconds 54 and another of microseconds. To handle both easily we use a single 55 arbitrary precision number for times with the actual resolution 56 returned as an RTS call. The intention is retain as much precision 57 as possible. *) 58 type time = LargeInt.int (* Becomes abstract *) 59 exception Time 60 61 (* Get the number of ticks per microsecond and compute the corresponding 62 values for milliseconds and seconds. *) 63 val ticksPerMicrosecond = RunCall.rtsCallFull0 "PolyTimingTicksPerMicroSec" () 64 val ticksPerMillisecond = ticksPerMicrosecond * 1000 65 val ticksPerSecond = ticksPerMillisecond * 1000 66 67 (* Check for very large time values. These cause problems if 68 converted to dates. *) 69 local 70 val Years100000 = ticksPerSecond*60*60*24*365*100000 71 in 72 fun checkTimeValue t = 73 if t < ~ Years100000 orelse t > Years100000 74 then raise Time else t 75 end; 76 77 (* The real representation is as a number of seconds. *) 78 local 79 val realTicks = Real.fromLargeInt ticksPerSecond 80 in 81 fun fromReal (x: real): time = 82 checkTimeValue(Real.toLargeInt IEEEReal.TO_NEAREST (x * realTicks)) 83 and toReal (t: time): real = Real.fromLargeInt t / realTicks 84 end 85 86 val zeroTime = fromReal 0.0 87 88 (* Convert to seconds, etc.*) 89 fun toSeconds x = x div ticksPerSecond 90 and toMilliseconds x = x div ticksPerMillisecond 91 and toMicroseconds x = x div ticksPerMicrosecond 92 and toNanoseconds x = x * 1000 div ticksPerMicrosecond 93 94 (* Convert from the integer representations. *) 95 fun fromSeconds i = checkTimeValue(i * ticksPerSecond) 96 and fromMilliseconds i = checkTimeValue(i * ticksPerMillisecond) 97 and fromMicroseconds i = checkTimeValue(i * ticksPerMicrosecond) 98 and fromNanoseconds i = checkTimeValue(i * ticksPerMicrosecond div 1000) 99 100 (* Format as a fixed precision number. if n < 0 treat as n = 0. *) 101 fun fmt n r = Real.fmt (StringCvt.FIX(SOME(Int.max(n, 0)))) (toReal r) 102 val toString = fmt 3 103 104 (* The scanned string is a subset of the format of a real number. 105 It does not have an exponent. At present we convert it as a real 106 number but it would probably be better to treat it as an integer. *) 107 fun scan getc src = 108 let 109 (* Return a list of digits. *) 110 fun getdigits inp src = 111 case getc src of 112 NONE => (List.rev inp, src) 113 | SOME(ch, src') => 114 if ch >= #"0" andalso ch <= #"9" 115 then getdigits ((Char.ord ch - Char.ord #"0") :: inp) src' 116 else (List.rev inp, src) 117 118 fun read_number sign src = 119 case getc src of 120 NONE => NONE 121 | SOME(ch, _) => 122 if not (ch >= #"0" andalso ch <= #"9" orelse ch = #".") 123 then NONE (* Bad "*) 124 else (* Digits or decimal. *) 125 let 126 (* Get the digits before the decimal point (if any) *) 127 val (intPart, src'') = getdigits [] src 128 (* Get the digits after the decimal point (if any). 129 If there is a decimal point we swallow the decimal only 130 if there is at least one digit after it. *) 131 val (decPart, srcAfterMant) = 132 case getc src'' of 133 SOME (#".", src''') => 134 ( (* Check that the next character is a digit. *) 135 case getc src''' of 136 NONE => ([], src'') 137 | SOME(ch, _) => 138 if ch >= #"0" andalso ch <= #"9" 139 then getdigits [] src''' 140 else ([], src'') 141 ) 142 | _ => ([], src'') 143 in 144 case (intPart, decPart) of 145 ([], []) => NONE (* Must have a digit either before or after the dp. *) 146 | _ => 147 let 148 (* Get exactly 9 digits after the decimal point. *) 149 val decs = intPart @ (List.take(decPart @ [ 0, 0, 0, 0, 0, 0, 0, 0, 0 ], 9)); 150 (* It's now in nanoseconds. *) 151 val toInt = List.foldl (fn (i, j) => LargeInt.fromInt i + j*10) (0: time) decs 152 in 153 SOME(fromNanoseconds(if sign then ~toInt else toInt), srcAfterMant) 154 end 155 end 156 in 157 case getc src of 158 NONE => NONE 159 | SOME(ch, src') => 160 if Char.isSpace ch (* Skip white space. *) 161 then scan getc src' (* Recurse *) 162 else if ch = #"+" (* Remove the + sign *) 163 then read_number false src' 164 else if ch = #"-" orelse ch = #"~" 165 then read_number true src' 166 else (* See if it's a valid digit or decimal point. *) 167 read_number false src 168 end 169 170 val fromString = StringCvt.scanString scan 171 172 (* Use the integer operations for these. *) 173 val op < : (time * time) -> bool = LargeInt.< 174 val op <= : (time * time) -> bool = LargeInt.<= 175 val op > : (time * time) -> bool = LargeInt.> 176 val op >= : (time * time) -> bool = LargeInt.>=; 177 178 val compare = LargeInt.compare 179 180 val op + : (time * time) -> time = LargeInt.+ 181 val op - : (time * time) -> time = LargeInt.- 182 183 local 184 val getNow: unit -> time = RunCall.rtsCallFull0 "PolyTimingGetNow" 185 in 186 fun now () = getNow() handle RunCall.SysErr _ => raise Time 187 end 188 189end; 190 191 192local 193 (* Install the pretty printer for Time.time. This has to be 194 done outside the structure because of the opaque matching. *) 195 fun pretty _ _ x = PolyML.PrettyString(Time.toString x) 196in 197 val () = PolyML.addPrettyPrinter pretty 198 (* Add overloads for +, -, <= etc *) 199 (* This is actually non-standard. The basis library documentation does 200 not include Time.time among the types for which these operators are 201 overloaded. *) 202 val () = RunCall.addOverload Time.+ "+"; 203 val () = RunCall.addOverload Time.- "-"; 204 val () = RunCall.addOverload Time.< "<"; 205 val () = RunCall.addOverload Time.> ">"; 206 val () = RunCall.addOverload Time.<= "<="; 207 val () = RunCall.addOverload Time.>= ">="; 208end 209