Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/idlbasis-devel/src/system/Basis/Implementation/date.sml
ViewVC logotype

Diff of /sml/branches/idlbasis-devel/src/system/Basis/Implementation/date.sml

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

revision 1245, Thu Jun 13 14:47:03 2002 UTC revision 1246, Thu Jun 13 16:09:36 2002 UTC
# Line 43  Line 43 
43              val monthTbl = #[Jan, Feb, Mar, Apr, May, Jun,              val monthTbl = #[Jan, Feb, Mar, Apr, May, Jun,
44                               Jul, Aug, Sep, Oct, Nov, Dec]                               Jul, Aug, Sep, Oct, Nov, Dec]
45    
46                fun intToDay i = InlineT.PolyVector.sub (dayTbl, i)
47                fun intToMonth i = InlineT.PolyVector.sub (monthTbl, i)
48    
49              (* tables for mapping integers to day/month-strings *)              (* tables for mapping integers to day/month-strings *)
50              val str_dayTbl = #["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]              val str_dayTbl = #["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
51              val str_monthTbl = #["Jan", "Feb", "Mar", "Apr", "May", "Jun",              val str_monthTbl = #["Jan", "Feb", "Mar", "Apr", "May", "Jun",
52                                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]                                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
53    
54                fun intToDayS i = InlineT.PolyVector.sub (str_dayTbl, i)
55                fun intToMonthS i = InlineT.PolyVector.sub (str_monthTbl, i)
56    
57              (* the tuple type used to communicate with C; this 9-tuple has the              (* the tuple type used to communicate with C; this 9-tuple has the
58               * fields:               * fields:
59               * tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday,               * tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday,
# Line 55  Line 61 
61               *)               *)
62              type tm = SMLBasis.Date_t              type tm = SMLBasis.Date_t
63    
   
64              (*              (*
65               * This code is taken from Reingold's paper               * This code is taken from Reingold's paper
66               *)               *)
# Line 63  Line 68 
68              val op // = Int.quot              val op // = Int.quot
69              val op %% = Int.rem              val op %% = Int.rem
70    
71              fun sum (f,k,p) =              fun sum (f, start, continue) =
72                  let fun loop (f,i,p,acc) = if (not(p(i))) then acc                  let fun loop (i, acc) = if not (continue i) then acc
73                                             else loop(f,i+1,p,acc+f(i))                                          else loop (i + 1, acc + f i)
74                  in                  in
75                      loop (f,k,p,0)                      loop (start, 0)
76                  end                  end
77    
78              fun lastDayOfGregorianMonth (month,year) =              fun count (start, continue) = sum (fn _ => 1, start, continue)
79    
80                (* last day of gregorian month: *)
81                fun ldgm (month,year) =
82                  if month = 1 andalso                  if month = 1 andalso
83                     (year %% 4) = 0 andalso                     (year %% 4) = 0 andalso
84                     let val m = year %% 400                     let val m = year %% 400
# Line 84  Line 92 
92                  val year1 = year - 1                  val year1 = year - 1
93              in              in
94                  day                  day
95                  + sum (fn (m) => lastDayOfGregorianMonth(m,year),0,                  + sum (fn m => ldgm (m, year), 0, fn m => m < month)
                        fn (m) => (m<month))  
96                  + 365 * year1                  + 365 * year1
97                  + (year1 // 4)                  + (year1 // 4)
98                  - (year1 // 100)                  - (year1 // 100)
# Line 94  Line 101 
101    
102              fun fromAbsolute abs =              fun fromAbsolute abs =
103                  let val approx = abs // 366                  let val approx = abs // 366
104                      val year =                      fun ycont y = abs >= toAbsolute (0, 1, y + 1)
105                          approx +                      val year = approx + count (approx, ycont)
106                          sum(fn _ => 1,                      fun mcont m = abs >= toAbsolute (m, ldgm (m, year), year)
107                              approx,                      val month = count (0, mcont)
                             fn y => abs >= toAbsolute (0, 1, y+1))  
                     val month =  
                         sum (fn _ =>1,  
                              0,  
                              fn m => abs > toAbsolute(m,lastDayOfGregorianMonth(m,year),year))  
108                      val day = abs - toAbsolute (month, 1, year) + 1                      val day = abs - toAbsolute (month, 1, year) + 1
109                  in                  in
110                      (month, day, year)                      (month, day, year)
111                  end                  end
112    
113              fun wday (month,day,year) =              fun wday (month,day,year) =
114                  let val abs = toAbsolute (month,day,year)                  intToDay (toAbsolute (month,day,year) %% 7)
                 in  
                     InlineT.PolyVector.sub (dayTbl, abs %% 7)  
                 end  
115    
116              fun yday (month, day, year) =              fun yday (month, day, year) =
117                  let val abs = toAbsolute (month, day, year)                  let val abs = toAbsolute (month, day, year)
# Line 149  Line 148 
148                | monthToInt Dec = 11                | monthToInt Dec = 11
149    
150              (*              (*
151               * this function should also canonicalize the time (hours, etc...)               * make a canonical date
152               *)               *)
153              fun canonicalizeDate (DATE d) =              fun canonicalizeDate (DATE d) =
154                  let val args = (monthToInt(#month d), #day d, #year d)                  let (* u_xxx is an 'unadjusted' xxx *)
155                        (* note that div and mod round towards -neginf
156                         * (which is exactly what we need here) *)
157                        val u_second = #second d
158                        val second = u_second mod 60
159                        val u_minute = #minute d + u_second div 60
160                        val minute = u_minute mod 60
161                        val u_hour = #hour d +u_minute div 60
162                        val hour = u_hour mod 24
163                        val dayadjust = u_hour div 24
164                        val args = (monthToInt(#month d),
165                                    #day d + dayadjust,
166                                    #year d)
167                      val (monthC,dayC,yearC) = fromAbsolute (toAbsolute (args))                      val (monthC,dayC,yearC) = fromAbsolute (toAbsolute (args))
168                      val yday = yday (args)                      val yday = yday (args)
169                      val wday = wday (args)                      val wday = wday (args)
170                  in                  in
171                      DATE {year = yearC,                      DATE {year = yearC,
172                            month = InlineT.PolyVector.sub (monthTbl,monthC),                            month = intToMonth monthC,
173                            day = dayC,                            day = dayC,
174                            hour = #hour d,                            hour = #hour d,
175                            minute = #minute d,                            minute = #minute d,
# Line 192  Line 203 
203                  let val i = Int32.toInt                  let val i = Int32.toInt
204                  in                  in
205                      DATE { year = baseYear + i tm_year,                      DATE { year = baseYear + i tm_year,
206                             month = InlineT.PolyVector.sub(monthTbl, i tm_mon),                             month = intToMonth (i tm_mon),
207                             day = i tm_mday,                             day = i tm_mday,
208                             hour = i tm_hour,                             hour = i tm_hour,
209                             minute = i tm_min,                             minute = i tm_min,
210                             second = i tm_sec,                             second = i tm_sec,
211                             wday = InlineT.PolyVector.sub (dayTbl, i tm_wday),                             wday = intToDay (i tm_wday),
212                             yday = i tm_yday,                             yday = i tm_yday,
213                             isDst = if ((tm_isdst : Int32.int) < 0) then NONE                             isDst = if ((tm_isdst : Int32.int) < 0) then NONE
214                                     else SOME(tm_isdst <> 0),                                     else SOME(tm_isdst <> 0),
# Line 271  Line 282 
282                  val cd = canonicalizeDate d                  val cd = canonicalizeDate d
283                  fun internalDate () =                  fun internalDate () =
284                      case offset of                      case offset of
285                          NONE => fromTimeLocal (toTime cd) (* why  not cd ?? *)                          NONE => fromTimeLocal (toTime_local cd)
286                        | SOME off => let                        | SOME off => let
287                              val PB.TIME t = Time.- (toTime cd, off)                              val PB.TIME t = Time.- (toTime_local cd, off)
288                          in                          in
289                              fromTM (SMLBasis.gmTime t) (SOME off)                              fromTM (SMLBasis.gmTime t) (SOME off)
290                          end                          end
# Line 289  Line 300 
300                  if size s = 1 then "0" ^ s else s                  if size s = 1 then "0" ^ s else s
301              end              end
302          in          in
303              concat [Vector.sub (str_dayTbl, dayToInt (#wday d)), " ",              concat [intToDayS (dayToInt (#wday d)), " ",
304                      Vector.sub (str_monthTbl, monthToInt (#month d)), " ",                      intToMonthS (monthToInt (#month d)), " ",
305                      dd #day, " ",                      dd #day, " ",
306                      dd #hour, ":", dd #minute, ":", dd #second, " ",                      dd #hour, ":", dd #minute, ":", dd #second, " ",
307                      Int.toString (#year d)]                      Int.toString (#year d)]
308          end          end
309    
310      (* FIXME: need support from IDL basis for this... *)      (* fmt uses C's strftime function.
311          fun fmt fmtStr d = (* strfTime (fmtStr, toTM d) *)       *   For this, we first fix up our format string so that
312              raise Fail "fmt not yet implemented"       *   format characters are interpreted according to the SML Basis spec. *)
313            fun fmt fmtStr d = let
314                val full = Substring.full
315                fun just c = full (StringImp.str c)
316                fun percent c = full ("%" ^ StringImp.str c)
317                fun notpercent #"%" = false
318                  | notpercent _ = true
319                fun fixup (f, a) = let
320                    val (l, r) = Substring.splitl notpercent f
321                    fun ret x = Substring.concat (x :: a)
322                in
323                    case Substring.getc r of
324                        NONE => ret l       (* no more % *)
325                      | SOME (_, r') =>
326                        (case Substring.getc r' of
327                             NONE => ret (percent #"%") (* trailing % *)
328                           | SOME (c, r'') =>
329                             if CharImp.contains "aAbBcdHIjmMpSUwWxXyYZ%" c then
330                                 (* %c sequences defined by SML Basis spec *)
331                                 fixup (r'', percent c :: l :: a)
332                             else
333                                 (* according to the SML Basis spec, all
334                                  * other %c sequences stand for c itself: *)
335                                 fixup (r'', just c :: l :: a))
336                end
337                val canonicalFmtStr = fixup (full fmtStr, [])
338            in
339                SMLBasis.strFTime (canonicalFmtStr, toTM d)
340            end
341    
342          (* Scanning in fairly high-level style. *)          (* Scanning in fairly high-level style. *)
343          fun scan gc = let          fun scan gc = let
# Line 311  Line 350 
350    
351              (* see if we can match any of the given keywords.              (* see if we can match any of the given keywords.
352               * if so, then invoke associated continuation.               * if so, then invoke associated continuation.
353               *    n -- size of all keywords               *    n -- size of keyword (must be the same for each)
354               *    kws -- list of pairs (keyword, continuation)               *    kws -- list of pairs (keyword, continuation)
355               *           continuation takes stream state               *           continuation takes stream state
356               *    ss -- initial stream state *)               *    ss -- initial stream state *)

Legend:
Removed from v.1245  
changed lines
  Added in v.1246

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