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

SCM Repository

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

Diff of /sml/trunk/src/system/Basis/Implementation/date.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 42  Line 42 
42          val monthTbl = #[Jan, Feb, Mar, Apr, May, Jun, Jul,          val monthTbl = #[Jan, Feb, Mar, Apr, May, Jun, Jul,
43                           Aug, Sep, Oct, Nov, Dec]                           Aug, Sep, Oct, Nov, Dec]
44    
45          fun dayToInt (d) = (case d          fun dayToInt Sun = 0
46                                  of Sun => 0 | Mon => 1 | Tue => 2 | Wed => 3            | dayToInt Mon = 1
47                                | Thu => 4 | Fri => 5 | Sat => 6            | dayToInt Tue = 2
48          (* end case *))            | dayToInt Wed = 3
49              | dayToInt Thu = 4
50              | dayToInt Fri = 5
51              | dayToInt Sat = 6
52    
53          (* careful about this: the month numbers are 0-11 *)          (* careful about this: the month numbers are 0-11 *)
54          fun monthToInt m = (case m          fun monthToInt Jan = 0
55                                  of Jan => 0 | Feb => 1 | Mar => 2 | Apr => 3 | May => 4 | Jun => 5            | monthToInt Feb = 1
56                                | Jul => 6 | Aug => 7 | Sep => 8 | Oct => 9 | Nov => 10 | Dec => 11            | monthToInt Mar = 2
57          (* end case *))            | monthToInt Apr = 3
58              | monthToInt May = 4
59          (* the tuple type used to communicate with C; this 9-tuple has the fields:            | monthToInt Jun = 5
60           * tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday, tm_yday,            | monthToInt Jul = 6
61           * and tm_isdst.            | monthToInt Aug = 7
62              | monthToInt Sep = 8
63              | monthToInt Oct = 9
64              | monthToInt Nov = 10
65              | monthToInt Doc = 11
66    
67            (* the tuple type used to communicate with C; this 9-tuple has the
68             * fields:
69             *   tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year,
70             *   tm_wday, tm_yday,
71             *   tm_isdst.
72           *)           *)
73          type tm = (int * int * int * int * int * int * int * int * int)          type tm = (int * int * int * int * int * int * int * int * int)
74    
75          (* wrap a C function call with a handler that maps SysErr exception into          (* wrap a C function call with a handler that maps SysErr
76           * Date exceptions.           * exception into Date exceptions.
77           *)           *)
78          fun wrap f x = (f x) handle _ => raise Date          fun wrap f x = (f x) handle _ => raise Date
79    
# Line 78  Line 91 
91          val strfTime : (string * tm) -> string          val strfTime : (string * tm) -> string
92              = wrap (CInterface.c_function "SMLNJ-Date" "strfTime")              = wrap (CInterface.c_function "SMLNJ-Date" "strfTime")
93    
94          val localTime = localTime' o Int32.fromLarge          val localTime = localTime' o Int32.fromLarge o Time.toSeconds
95          val gmTime = gmTime' o Int32.fromLarge          val gmTime = gmTime' o Int32.fromLarge o Time.toSeconds
96          val mkTime = Int32.toLarge o mkTime'          val mkTime = Time.fromSeconds o Int32.toLarge o mkTime'
97    
98          fun year (DATE{year, ...}) = year          fun year (DATE{year, ...}) = year
99          fun month (DATE{month, ...}) = month          fun month (DATE{month, ...}) = month
# Line 93  Line 106 
106          fun isDst (DATE{isDst, ...}) = isDst          fun isDst (DATE{isDst, ...}) = isDst
107          fun offset (DATE{offset,...}) = offset          fun offset (DATE{offset,...}) = offset
108    
109            (* takes two tm's and returns the second tm with
110             * its dst flag set to the first one's.
111             * Used to compute local offsets
112             *)
113            fun withDst dst (tm2 : tm) : tm=
114                (#1 tm2, #2 tm2, #3 tm2, #4 tm2, #5 tm2, #6 tm2, #7 tm2, #8 tm2,
115                 dst)
116    
117            fun dstOf (tm : tm) = #9 tm
118    
119            fun localOffset' () = let
120                val t = Int32.fromLarge (Time.toSeconds (Time.now ()))
121                val t_as_utc_tm = gmTime' t
122                val t_as_loc_tm = localTime' t
123                val loc_dst = dstOf t_as_loc_tm
124                val t_as_utc_tm' = withDst loc_dst t_as_utc_tm
125                val t' = mkTime' t_as_utc_tm'
126                val time = Time.fromSeconds o Int32.toLarge
127            in
128                (Time.- (time t', time t), loc_dst)
129            end
130    
131            val localOffset = #1 o localOffset'
132    
133          (*          (*
134           * This code is taken from Reingold's paper           * This code is taken from Reingold's paper
# Line 187  Line 223 
223                                       (* end case *)                                       (* end case *)
224                                       )                                       )
225    
226          fun fromTM (          fun fromTM (tm_sec, tm_min, tm_hour, tm_mday, tm_mon,
227                      tm_sec, tm_min, tm_hour, tm_mday, tm_mon,                      tm_year, tm_wday, tm_yday, tm_isdst) offset =
228                      tm_year, tm_wday, tm_yday, tm_isdst              DATE { year = baseYear + tm_year,
                     ) offset = DATE{  
                                     year = baseYear + tm_year,  
229                                      month = InlineT.PolyVector.sub(monthTbl, tm_mon),                                      month = InlineT.PolyVector.sub(monthTbl, tm_mon),
230                                      day = tm_mday,                                      day = tm_mday,
231                                      hour = tm_hour,                                      hour = tm_hour,
# Line 199  Line 233 
233                                      second = tm_sec,                                      second = tm_sec,
234                                      wday = InlineT.PolyVector.sub(dayTbl, tm_wday),                                      wday = InlineT.PolyVector.sub(dayTbl, tm_wday),
235                                      yday = tm_yday,                                      yday = tm_yday,
236                                      isDst = if (tm_isdst < 0) then NONE else SOME(tm_isdst <> 0),                     isDst = if (tm_isdst < 0) then NONE
237                                      offset = offset                             else SOME(tm_isdst <> 0),
238                                      }                     offset = offset }
239    
         (* takes two tm's and returns the second tm with  
          * its dst flag set to the first one's.  
          * Used to compute local offsets  
          *)  
         fun toSameDstTM ((tm_sec, tm_min, tm_hour, tm_mday, tm_mon,  
                           tm_year, tm_wday, tm_yday, tm_isdst),  
                          (tm_sec', tm_min', tm_hour', tm_mday', tm_mon',  
                           tm_year', tm_wday', tm_yday', tm_isdst')) =  
             (tm_sec', tm_min', tm_hour', tm_mday', tm_mon',  
              tm_year', tm_wday', tm_yday', tm_isdst)  
240    
241          (* a diff is +/- seconds between local time and gmt          fun fromTimeLocal t = fromTM (localTime t) NONE
          * what to add to local time to get gmt  
          *)  
242    
243          val secInDay : IntInf.int  = 60 * 60 * 24          fun fromTimeUniv t = fromTM (gmTime t) (SOME Time.zeroTime)
         val secInHDay : IntInf.int = 30 * 30 * 24  
 (*  
         fun diffToOffset (d) =  
             if (d<0) then Time.fromSeconds (secInDay+d)  
             else Time.fromSeconds(d)  
 *)  
         fun offsetToDiff (off) =  
             let val s = Time.toSeconds (off)  
             in  
                 if (s>secInHDay) then secInHDay-s else s  
             end  
244    
245          (*          fun fromTimeOffset (t, offset) =
246           * this function is meant as an analogue to              fromTM (gmTime (Time.- (t, offset))) (SOME offset)
247           * mkTime, but constructs UTC time instead of localtime  
248           * idea:  mkTime (localtime(t))= t          val day_seconds = IntInfImp.fromInt (24 * 60 * 60)
249           *        mkGMTime (gmtime(t))= t          val hday_seconds = IntInfImp.fromInt (12 * 60 * 60)
          *)  
250    
251          fun localDiff (tm) =          fun canonicalOffset off = let
252              let val t = mkTime (tm)              val offs = Time.toSeconds off
253                  val loc = localTime (t)              val offs' = offs mod day_seconds
254                  val gmt = gmTime (t)              val offs'' = if offs' > hday_seconds then offs' - day_seconds
255                             else offs'
256              in              in
257                  mkTime (toSameDstTM(loc,gmt)) - mkTime(loc)              Time.fromSeconds offs''
258              end              end
259    
260          fun mkGMTime (tm) = mkTime (toSameDstTM (localTime(mkTime(tm)),tm)) -          fun toTime d = let
261              localDiff (tm)              val tm = toTM d
262            in
263          fun toSeconds (d) =              case offset d of
264              let val tm = toTM (d)                  NONE => mkTime tm
265                  | SOME tm_utc_off => let
266                        val tm_utc_off = canonicalOffset tm_utc_off
267                        val (loc_utc_off, loc_dst) = localOffset' ()
268                        (* time west of here *)
269                        val tm_loc_off = Time.- (tm_utc_off, loc_utc_off)
270              in              in
271                  case (offset d) of                      (* pretend tm refers to local time, then subtract
272                      NONE => mkTime (tm)                       * difference between dest. and local time *)
273                    | SOME (offsetV) =>                      Time.- (mkTime (withDst loc_dst tm), tm_loc_off)
274                        mkGMTime (tm) + offsetToDiff (offsetV)                  end
275              end              end
276    
277          val toTime = Time.fromSeconds o toSeconds          fun date { year, month, day, hour, minute, second, offset } = let
278                val d = DATE { second = second,
         fun fromTimeLocal (t) =  
             fromTM (localTime (Time.toSeconds (t))) NONE  
   
         fun fromTimeOffset (t, offset) =  
             fromTM (gmTime (Time.toSeconds (t) - Time.toSeconds(offset)))  
             (SOME offset)  
   
         fun fromTimeUniv (t) = fromTimeOffset (t,Time.zeroTime)  
   
         fun date {year,month,day,hour,minute,second,offset} =  
             let val d = DATE {second = second,  
279                                minute = minute,                                minute = minute,
280                                hour = hour,                                hour = hour,
281                                year = year,                                year = year,
# Line 280  Line 285 
285                                isDst = NONE,                                isDst = NONE,
286                                yday = 0,                                yday = 0,
287                                wday = Mon}                                wday = Mon}
288                  val canonicalDate = canonicalizeDate (d)              val canonicalDate = canonicalizeDate d
289                  fun internalDate () =                  fun internalDate () =
290                      (case (offset) of                  case offset of
291                           NONE => fromTimeLocal (toTime canonicalDate)                           NONE => fromTimeLocal (toTime canonicalDate)
292                         | SOME (offsetV) => fromTimeOffset (toTime canonicalDate,                    | SOME off => fromTimeOffset (toTime canonicalDate, off)
                                                            offsetV))  
293              in              in
294                  internalDate () handle Date => d                  internalDate () handle Date => d
295              end              end
296    
297          fun toString d = ascTime (toTM d)          fun toString d = ascTime (toTM d)
   
298          fun fmt fmtStr d = strfTime (fmtStr, toTM d)          fun fmt fmtStr d = strfTime (fmtStr, toTM d)
299    
300          (**          fun scan getc s = let
 val fromString : string -> date option  
 val scan       : (getc : (char, 'a) StringCvt.reader) -> 'a -> (date * 'a) option  
          **)  
301    
302                fun getword s = StringCvt.splitl Char.isAlpha getc s
303    
304                fun expect c s f =
305                    case getc s of
306                        NONE => NONE
307                      | SOME (c', s') => if c = c' then f s' else NONE
308    
309                fun getdig s =
310                    case getc s of
311                        NONE => NONE
312                      | SOME (c, s') =>
313                          if Char.isDigit c then
314                              SOME (Char.ord c - Char.ord #"0", s')
315                          else NONE
316    
317                fun get2dig s =
318                    case getdig s of
319                        SOME (c1, s') =>
320                          (case getdig s' of
321                               SOME (c2, s'') => SOME (10 * c1 + c2, s'')
322                             | NONE => NONE)
323                      | NONE => NONE
324    
325                fun year0 (wday, mon, d, hr, mn, sc) s =
326                    case IntImp.scan StringCvt.DEC getc s of
327                        NONE => NONE
328                      | SOME (yr, s') =>
329                          (SOME (date { year = yr,
330                                        month = mon,
331                                        day = d, hour = hr,
332                                        minute = mn, second = sc,
333                                        offset = NONE },
334                                 s')
335                           handle _ => NONE)
336    
337                fun year args s = expect #" " s (year0 args)
338    
339                fun second0 (wday, mon, d, hr, mn) s =
340                    case get2dig s of
341                        NONE => NONE
342                      | SOME (sc, s') => year (wday, mon, d, hr, mn, sc) s'
343    
344                fun second args s = expect #":" s (second0 args)
345    
346                fun minute0 (wday, mon, d, hr) s =
347                    case get2dig s of
348                        NONE => NONE
349                      | SOME (mn, s') => second (wday, mon, d, hr, mn) s'
350    
351                fun minute args s = expect #":" s (minute0 args)
352    
353                fun time0 (wday, mon, d) s =
354                    case get2dig s of
355                        NONE => NONE
356                      | SOME (hr, s') => minute (wday, mon, d, hr) s'
357    
358                fun time args s = expect #" " s (time0 args)
359    
360                fun mday0 (wday, mon) s =
361                    case get2dig s of
362                        NONE => NONE
363                      | SOME (d, s') => time (wday, mon, d) s'
364    
365                fun mday args s = expect #" " s (mday0 args)
366    
367                fun month0 wday s =
368                    case getword s of
369                        ("Jan", s') => mday (wday, Jan) s'
370                      | ("Feb", s') => mday (wday, Feb) s'
371                      | ("Mar", s') => mday (wday, Mar) s'
372                      | ("Apr", s') => mday (wday, Apr) s'
373                      | ("May", s') => mday (wday, May) s'
374                      | ("Jun", s') => mday (wday, Jun) s'
375                      | ("Jul", s') => mday (wday, Jul) s'
376                      | ("Aug", s') => mday (wday, Aug) s'
377                      | ("Sep", s') => mday (wday, Sep) s'
378                      | ("Oct", s') => mday (wday, Oct) s'
379                      | ("Nov", s') => mday (wday, Nov) s'
380                      | ("Dec", s') => mday (wday, Dec) s'
381                      | _ => NONE
382    
383                fun month wday s = expect #" " s (month0 wday)
384    
385                fun wday s =
386                    case getword s of
387                        ("Sun", s') => month Sun s'
388                      | ("Mon", s') => month Mon s'
389                      | ("Tue", s') => month Tue s'
390                      | ("Wed", s') => month Wed s'
391                      | ("Thu", s') => month Thu s'
392                      | ("Fri", s') => month Fri s'
393                      | ("Sat", s') => month Sat s'
394                      | _ => NONE
395            in
396                wday s
397            end
398    
399            fun fromString s = StringCvt.scanString scan s
400    
401          (* comparison does not take into account the offset          (* comparison does not take into account the offset
402           * thus, it does not compare dates in different time zones           * thus, it does not compare dates in different time zones
403           *)           *)
404          fun compare (DATE d1, DATE d2) = let          fun compare (d1, d2) = let
405                                               fun cmp (i1::r1, i2::r2) =              fun list (DATE { year, month, day, hour, minute, second, ... }) =
406                                                   if (i1 < i2) then LESS                  [year, monthToInt month, day, hour, minute, second]
407                                                   else if (i1 = i2) then cmp (r1, r2)          in
408                                                        else GREATER              List.collate Int.compare (list d1, list d2)
                                                | cmp _ = EQUAL  
                                          in  
                                              cmp (  
                                                   [#year d1, monthToInt(#month d1), #day d1, #hour d1, #minute d1, #second d1],  
                                                   [#year d2, monthToInt(#month d2), #day d2, #hour d2, #minute d2, #second d2])  
409                                           end                                           end
410    
411      end      end
412  end  end
   

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