Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

SCM Repository

[smlnj] Diff of /sml/trunk/src/system/Basis/Implementation/time.sml
ViewVC logotype

Diff of /sml/trunk/src/system/Basis/Implementation/time.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1349, Wed Sep 3 22:22:18 2003 UTC revision 1350, Fri Sep 5 21:34:27 2003 UTC
# Line 3  Line 3 
3   * COPYRIGHT (c) 1995 AT&T Bell Laboratories.   * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4   *   *
5   *)   *)
   
6  structure TimeImp : TIME =  structure TimeImp : TIME =
7    struct    struct
8    
# Line 19  Line 18 
18    
19      exception Time      exception Time
20    
21      val zeroTime = PB.TIME{sec=0, usec=0}      infix quot
22        val op quot = LInt.quot
23    
24      fun toSeconds (PB.TIME{sec, ...}) = sec      val zeroTime = PB.TIME { usec = 0 }
     fun fromSeconds sec =  
           if (sec < 0)  
             then raise Time  
             else PB.TIME{sec=sec, usec=0}  
   
     fun toMilliseconds (PB.TIME{sec, usec}) =  
           (sec * 1000) + LInt.quot(usec, 1000)  
     fun fromMilliseconds msec =  
           if (msec < 0)  
             then raise Time  
           else if (msec >= 1000)  
             then PB.TIME{sec= LInt.quot(msec, 1000), usec= 1000*(LInt.rem(msec, 1000))}  
             else PB.TIME{sec= 0, usec= 1000*msec}  
   
     fun toMicroseconds (PB.TIME{sec, usec}) =  
           (sec * 1000000) + usec  
     fun fromMicroseconds usec =  
           if (usec < 0)  
             then raise Time  
           else if (usec >= 1000000)  
             then PB.TIME{sec= LInt.quot(usec, 1000000), usec= LInt.rem(usec,  1000000)}  
             else PB.TIME{sec=0, usec=usec}  
25    
26      local      (* rounding is towards ZERO *)
27      (* a floor function that produces a FixedInt.int *)      fun toSeconds (PB.TIME { usec }) = usec quot 1000000
28        val floor = Real.toLargeInt IEEEReal.TO_NEGINF      fun fromSeconds sec = PB.TIME { usec = sec * 1000000 }
29        val t2r = Real.fromLargeInt      fun toMilliseconds (PB.TIME { usec }) = usec quot 1000
30      in      fun fromMilliseconds msec = PB.TIME { usec = msec * 1000 }
31      fun fromReal rt = if (rt < 0.0)      fun toMicroseconds (PB.TIME { usec }) = usec
32            then raise Time      fun fromMicroseconds usec = PB.TIME { usec = usec }
33            else let  
34              val sec = floor rt      fun fromReal rsec =
35              in          PB.TIME { usec = Real.toLargeInt IEEEReal.TO_ZERO (rsec * 1.0e6) }
36                PB.TIME{sec=sec, usec=floor((rt - t2r sec) * 1000000.0)}      fun toReal (PB.TIME { usec }) =
37              end          Real.fromLargeInt usec * 1.0e~6
               handle Overflow => raise Time  
   
     fun toReal (PB.TIME{sec, usec}) = (t2r sec) + ((t2r usec) * 0.000001)  
     end (* local *)  
   
     fun add (PB.TIME{sec=s1, usec=u1}, PB.TIME{sec=s2, usec=u2}) = let  
           val s = s1 + s2  
           val u = u1+u2  
           in  
             if (u >= 1000000)  
               then PB.TIME{sec=s+1, usec=u-1000000}  
               else PB.TIME{sec=s, usec=u}  
           end  
     fun sub (PB.TIME{sec=s1, usec=u1}, PB.TIME{sec=s2, usec=u2}) = let  
           val s = s1 - s2  
           val u = u1 - u2  
           val (s, u) = if (u < 0) then (s-1, u+1000000) else (s, u)  
           in  
             if (s < 0)  
               then raise Time  
               else PB.TIME{sec=s, usec=u}  
           end  
   
     fun compare (PB.TIME{sec=s1, usec=u1}, PB.TIME{sec=s2, usec=u2}) =  
           if (s1 < s2) then LESS  
           else if (s1 = s2)  
             then if (u1 < u2) then LESS  
             else if (u1 = u2) then EQUAL  
             else GREATER  
           else GREATER  
   
     fun less (PB.TIME{sec=s1, usec=u1}, PB.TIME{sec=s2, usec=u2}) =  
           (s1 < s2) orelse ((s1 = s2) andalso (u1 < u2))  
     fun lessEq (PB.TIME{sec=s1, usec=u1}, PB.TIME{sec=s2, usec=u2}) =  
           (s1 < s2) orelse ((s1 = s2) andalso (u1 <= u2))  
38    
39      local      local
40        val gettimeofday : unit -> (Int32.int * int) =        val gettimeofday : unit -> (Int32.int * int) =
41              CInterface.c_function "SMLNJ-Time" "timeofday"              CInterface.c_function "SMLNJ-Time" "timeofday"
42      in      in
43      fun now () = let val (ts, tu) = gettimeofday()          fun now () = let
44                val (ts, tu) = gettimeofday ()
45            in            in
46              PB.TIME{sec= Int32.toLarge ts, usec= Int.toLarge tu }              fromMicroseconds (1000000 * Int32.toLarge ts + Int.toLarge tu)
47            end            end
48      end (* local *)      end (* local *)
49    
50      local      val rndv : LInt.int vector =  #[50000, 5000, 500, 50, 5]
51        val zeros = "0000000000"  
52        val numZeros = String.size zeros      fun fmt prec (PB.TIME { usec }) = let
53        fun pad 0 = []          val (neg, usec) = if usec < 0 then (true, ~usec) else (false, usec)
54          | pad n = if (n <= numZeros)          fun fmtInt i = LInt.fmt StringCvt.DEC i
55              then [substring(zeros, 0, n)]          fun fmtSec (neg, i) = fmtInt (if neg then ~i else i)
56              else zeros :: pad(n - numZeros)          fun isEven i = LInt.rem (i, 2) = 0
57        val rounding = #[      in
58                PB.TIME{sec=0, usec= 50000},          if prec <= 0 then
59                PB.TIME{sec=0, usec=  5000},              let val (sec, usec) = IntInfImp.quotRem (usec, 1000000)
60                PB.TIME{sec=0, usec=   500},                  val sec =
61                PB.TIME{sec=0, usec=    50},                      case LInt.compare (usec, 500000) of
62                PB.TIME{sec=0, usec=     5}                          LESS => sec
63              ]                        | GREATER => sec + 1
64        val fmtInt = IntInfImp.fmt StringCvt.DEC                        | EQUAL => if isEven sec then sec else sec + 1
65        fun fmtUSec usec = let              in
66              val usec' = fmtInt usec                  fmtSec (neg, sec)
67              in              end
68                String.substring(zeros, 0, 6 - String.size usec') ^ usec'          else if prec >= 6 then
69              end              let val (sec, usec) = IntInfImp.quotRem (usec, 1000000)
70      in              in
71      fun fmt prec = if (prec <= 0)                  concat [fmtSec (neg, sec), ".",
72              then let                          StringCvt.padLeft #"0" 6 (fmtInt usec),
73                fun fmt' t = let                          StringCvt.padLeft #"0" (prec - 6) ""]
74                      val PB.TIME{sec, ...} = add(t, PB.TIME{sec=0, usec=500000})              end
75                      in          else
76                        fmtInt sec              let val rnd = Vector.sub (rndv, prec - 1)
77                      end                  val (whole, frac) = IntInfImp.quotRem (usec, 2 * rnd)
78                in                  val whole =
79                  fmt'                      case LInt.compare (frac, rnd) of
80                end                          LESS => whole
81            else if (prec >= 6)                        | GREATER => whole + 1
82              then let                        | EQUAL => if isEven whole then whole else whole + 1
83                fun fmt' (PB.TIME{sec, usec}) =                  val rscl = 2 * Vector.sub (rndv, 5 - prec)
84                      String.concat(fmtInt sec :: "." :: fmtUSec usec :: pad(prec-6))                  val (sec, frac) = IntInfImp.quotRem (whole, rscl)
85                in              in
86                  fmt'                  concat [fmtSec (neg, sec), ".",
87                end                          StringCvt.padLeft #"0" prec (fmtInt frac)]
             else let (* 0 < prec < 6 *)  
               val amt = InlineT.PolyVector.sub(rounding, prec-1)  
               fun fmt' t = let  
                     val PB.TIME{sec, usec} = add(t, amt)  
                     in  
                       String.concat[  
                           fmtInt sec, ".", String.substring(fmtUSec usec, 0, prec)  
                         ]  
                     end  
               in  
                 fmt'  
               end  
 (*  
     fun fmt prec (PB.TIME{sec, usec}) = let  
           val sec' = fmtInt sec  
           in  
             if (prec <= 0)  
               then sec'  
               else let  
                 val usec' = fmtInt usec  
                 val frac = String.substring(zeros, 0, 6 - String.size usec') ^ usec'  
                 in  
                   if (prec < 6)  
                     then String.concat [  
                         sec', ".", String.substring(frac, 0, prec)  
                       ]  
                     else String.concat (sec' :: "." :: frac :: pad(prec-6))  
88                  end                  end
89            end            end
 *)  
     end (* local *)  
90    
91    (* scan a time value; this has the syntax:    (* scan a time value; this has the syntax:
92     *     *
93     *  [0-9]+(.[0-9]+)? | .[0-9]+     *  [+-~]?([0-9]+(.[0-9]+)? | .[0-9]+)
94     *)     *)
95      fun scan getc charStrm = let      fun scan getc s = let
96            val chrLE : (char * char) -> bool = InlineT.cast InlineT.DfltInt.<=  
97            fun isDigit c = (chrLE(#"0", c) andalso chrLE(c, #"9"))          fun digv c = Int.toLarge (Char.ord c - Char.ord #"0")
98            fun incByDigit (n, c) =  
99                10*n + Int.toLarge(Char.ord c - Char.ord #"0")          fun whole s = let
100            fun scanSec (secs, cs) = (case (getc cs)              fun loop (s, n, m, ret) =
101                   of NONE => SOME(PB.TIME{sec=secs, usec=0}, cs)                  case getc s of
102                    | (SOME(#".", cs')) => (case (getc cs')                      NONE => ret (n, s, m)
103                         of NONE => SOME(PB.TIME{sec=secs, usec=0}, cs)                    | SOME (c, s') =>
104                          | (SOME(d, cs'')) => if (isDigit d)                        if Char.isDigit c then
105                              then scanUSec (secs, cs')                            loop (s', 10 * n + digv c, m + 1, SOME)
106                              else SOME(PB.TIME{sec=secs, usec=0}, cs)                        else ret (n, s, m)
107                        (* end case *))          in
108                    | (SOME(d, cs')) => if (isDigit d)              loop (s, 0, 0, fn _ => NONE)
109                        then scanSec(incByDigit(secs, d), cs')          end
110                        else SOME(PB.TIME{sec=secs, usec=0}, cs)  
111                  (* end case *))          fun time (negative, s) = let
112            and scanUSec (secs, cs) = let              fun pow10 p = IntInfImp.pow (10, p)
113                  fun normalize (usecs, 6) = usecs              fun return (usec, s) =
114                    | normalize (usecs, n) = normalize(10*usecs, n+1)                  SOME (fromMicroseconds (if negative then ~usec else usec), s)
115                  fun scan' (usecs, 6, cs) = (case (getc cs)              fun fractional (wh, s) =
116                         of NONE => (usecs, cs)                  case whole s of
117                          | (SOME(d, cs')) => if (isDigit d)                      SOME (n, s, m) => let
118                              then scan' (usecs, 6, cs')                          fun done fr = return (wh * 1000000 + fr, s)
119                              else (usecs, cs)                      in
120                        (* end case *))                          if m > 6 then done (n div pow10 (m - 6))
121                    | scan' (usecs, ndigits, cs) = (case (getc cs)                          else if m < 6 then done (n * pow10 (6 - m))
122                         of NONE => (normalize(usecs, ndigits), cs)                          else done n
123                          | (SOME(d, cs')) => if (isDigit d)                      end
124                              then scan' (incByDigit(usecs, d), ndigits+1, cs')                    | NONE => NONE
125                              else (normalize(usecs, ndigits), cs)              fun withwhole s =
126                        (* end case *))                  case whole s of
127                  val (usecs, cs) = scan' (0, 0, cs)                      NONE => NONE
128                  in                    | SOME (wh, s', _) =>
129                    SOME(PB.TIME{sec=secs, usec=usecs}, cs)                        (case getc s' of
130                  end                             SOME (#".", s'') => fractional (wh, s'')
131            val cs = PB.skipWS getc charStrm                           | _ => return (wh * 1000000, s'))
132            in          in
133              case (getc cs)              case getc s of
134               of NONE => NONE                  NONE => NONE
135                | (SOME(#".", cs')) => (case (getc cs')                | SOME (#".", s') => fractional (0, s')
136                     of NONE => NONE                | _ => withwhole s
137                      | (SOME(d, _)) =>          end
138                          if (isDigit d) then scanUSec (0, cs') else NONE  
139                    (* end case *))          fun sign s =
140                | (SOME(d, _)) => if (isDigit d) then scanSec(0, cs) else NONE              case getc s of
141              (* end case *)                  NONE => NONE
142                  | SOME ((#"-" | #"~"), s') => time (true, s')
143                  | SOME (#"+", s') => time (false, s')
144                  | _ => time (false, s)
145        in
146            sign (StringCvt.skipWS getc s)
147            end            end
148    
149      val toString   = fmt 3      val toString   = fmt 3
150      val fromString = PB.scanString scan      val fromString = PB.scanString scan
151    
152      val (op +) = add      local
153      val (op -) = sub          fun binop usecoper (PB.TIME t1, PB.TIME t2) =
154                usecoper (#usec t1, #usec t2)
155        in
156    
157      val (op <)  = less      val op + = binop (fromMicroseconds o op +)
158      val (op <=) = lessEq      val op - = binop (fromMicroseconds o op -)
159      val (op >)  = Bool.not o lessEq      val compare = binop LInt.compare
160      val (op >=) = Bool.not o less      val op < = binop op <
161        val op <= = binop op <=
162        val op > = binop op >
163        val op >= = binop op >=
164    
165    end (* TIME *)      end
166    
167      end (* TIME *)

Legend:
Removed from v.1349  
changed lines
  Added in v.1350

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0