DIRECTORY Ascii USING [SP, TAB], BasicTime USING [GMT], DateAndTime USING [Notes], Rope USING [Equal, Fetch, Length, ROPE, Substr, Upper], System USING [ GetLocalTimeParameters, gmtEpoch, LocalTimeParameters, LocalTimeParametersUnknown]; DateAndTimeImpl: PROGRAM IMPORTS Rope, System EXPORTS DateAndTime = BEGIN Unintelligible: PUBLIC SAFE ERROR [vicinity: NAT] = CODE; hoursPerDay: INT = 24; minutesPerHour: INT = 60; secondsPerMinute: INT = 60; secondsPerDay: INT = hoursPerDay*minutesPerHour*secondsPerMinute; baseYear: NAT = 1968; baseDay: NAT[0..7) = 1; -- January 1, 1968 was a Monday (0 = Sunday) EpochDays: TYPE = INT[0..LAST[LONG CARDINAL]/secondsPerDay]; YearDays: TYPE = INT[0..366]; Year: TYPE = [baseYear..baseYear+(LAST[EpochDays]/(4*365+1))*4]; Month: TYPE = [1..12]; Day: TYPE = [1..31]; Hour: TYPE = [0..hoursPerDay); Minute: TYPE = [0..minutesPerHour); Second: TYPE = [0..secondsPerMinute); DeltaMinutes: TYPE = INT --(-hoursPerDay*minutesPerHour..hoursPerDay*minutesPerHour)--; ZoneIndex: TYPE = INT [-12..12]; NAZones: TYPE = ZoneIndex [-11..-4]; Parse: PUBLIC SAFE PROC [r: Rope.ROPE] RETURNS [dt: BasicTime.GMT, notes: DateAndTime.Notes, length: NAT] = TRUSTED { maxReasonableTokens: NAT = 30; TokenCount: TYPE = NAT[0..maxReasonableTokens]; TokenIndex: TYPE = NAT[FIRST[TokenCount]..LAST[TokenCount]); CharIndex: TYPE = NAT; CharCount: TYPE = NAT[0..37777B]; -- this upper bound saves a word in Token Tokens: TYPE = RECORD [ nTokens: TokenCount _ 0, tokens: SEQUENCE length: TokenCount OF Token _ NULL]; Token: TYPE = RECORD [ offset: CharIndex, kind: SELECT type: * FROM alpha => [length: CharCount], num => [length: CharCount], sep => [char: CHARACTER], ENDCASE]; input: REF Tokens _ NEW[Tokens[maxReasonableTokens] _ []]; sentinel: CHARACTER = 200C; Bogus: PROC [ti: TokenIndex] = {ERROR Unintelligible[input.tokens[ti].offset]}; AddToken: PROC [t: Token] = { IF input.nTokens = input.length THEN input.tokens[input.nTokens-1] _ t ELSE {input.tokens[input.nTokens] _ t; input.nTokens _ input.nTokens + 1}; }; Tokenize: PROC = { state: {initial, num, alpha} _ initial; i: NAT _ 0; tStart: NAT; AddToken[[0, sep[sentinel]]]; DO char: CHARACTER; SELECT TRUE FROM r = NIL, i = r.Length[] => char _ sentinel; (char _ r.Fetch[i]) = Ascii.TAB => char _ Ascii.SP; char IN [40C..176C] => NULL; ENDCASE => --illegal; terminate scan-- char _ sentinel; SELECT char FROM IN ['0..'9] => SELECT state FROM initial => {state _ num; tStart _ i}; num => NULL; alpha => {AddToken[[tStart, alpha[i-tStart]]]; state _ num; tStart _ i}; ENDCASE; ',, '., ':, '/, '-, '+, Ascii.SP, sentinel => { SELECT state FROM initial => NULL; num => {AddToken[[tStart, num[i-tStart]]]; state _ initial}; alpha => {AddToken[[tStart, alpha[i-tStart]]]; state _ initial}; ENDCASE; WITH t: input.tokens[input.nTokens-1] SELECT FROM sep => IF t.char = Ascii.SP THEN t.char _ char ELSE IF char ~= Ascii.SP THEN --illegal-- t.char _ char _ sentinel; ENDCASE => AddToken[[i, sep[char]]]; IF char = sentinel THEN EXIT}; ENDCASE => SELECT state FROM initial => {state _ alpha; tStart _ i}; num => {AddToken[[tStart, num[i-tStart]]]; state _ alpha; tStart _ i}; alpha => NULL; ENDCASE; i _ i + 1; ENDLOOP; }; year: Year; month: Month; day: Day; hour: Hour; minute: Minute; second: Second; zoneAdjust: DeltaMinutes; dst: BOOL; cumDays: ARRAY [FIRST[Month]-1..LAST[Month]] OF NAT = [ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366]; OutOfRange: ERROR [errorPos: NAT] = CODE; CollectValue: PROC [t: num Token, low, high: NAT] RETURNS [value: NAT _ 0] = { FOR j: CharIndex IN [t.offset..t.offset+t.length) DO IF value > LAST[NAT]/10 - 1 THEN ERROR OutOfRange[j]; value _ value * 10 + (r.Fetch[j] - '0); ENDLOOP; IF ~(value IN [low..high]) THEN ERROR OutOfRange[t.offset+t.length]; }; ParseDate: PROC [first: TokenIndex] RETURNS [next: TokenIndex] = { BogusMonth: ERROR = CODE; ParseSymbolicMonth: PROC [t: alpha Token] RETURNS [month: Month] = { MonthNames: TYPE = ARRAY Month OF Rope.ROPE; m: Rope.ROPE = r.Substr[start: t.offset, len: t.length]; SELECT Rope.Upper[r.Fetch[t.offset]] FROM 'I, 'V, 'X => { roman: MonthNames _ [ "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII"]; FOR month IN Month DO IF m.Equal[s2: roman[month], case: FALSE] THEN EXIT; REPEAT FINISHED => ERROR BogusMonth; ENDLOOP }; ENDCASE => { english: MonthNames _ [ "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]; IF t.length < 3 THEN ERROR BogusMonth; FOR month IN Month DO IF m.Equal[s2: english[month], case: FALSE] THEN EXIT; REPEAT FINISHED => ERROR BogusMonth; ENDLOOP }; }; CollectYear: PROC [y: num Token] RETURNS [Year] = { RETURN[1900+CollectValue[y, FIRST[Year]-1900, 99 ! OutOfRange => CONTINUE]]; RETURN[CollectValue[y, FIRST[Year], LAST[Year]]] }; CollectMonth: PROC [m: num Token] RETURNS [Month] = INLINE {RETURN[CollectValue[m, FIRST[Month], LAST[Month]]]}; CollectDay: PROC [d: num Token, m: Month] RETURNS [Day] = INLINE {RETURN[CollectValue[d, FIRST[Day], cumDays[m]-cumDays[m-1]]]}; DO ENABLE OutOfRange => ERROR Unintelligible[errorPos]; second, third: TokenIndex; t: num Token; GetThird: PROC = { WITH token: input.tokens[third] SELECT FROM num => t _ token; ENDCASE => Bogus[third] }; IF input.nTokens < first + 3 OR input.tokens[first].type = sep THEN Bogus[first]; IF input.tokens[second_first+1].type = sep THEN second _ second + 1; IF input.tokens[third_second+1].type = sep THEN { IF third = input.nTokens-1 THEN Bogus[third]; third _ third + 1}; WITH f: input.tokens[first] SELECT FROM alpha => { month _ ParseSymbolicMonth[f ! BogusMonth => {first _ second; LOOP}]; WITH d: input.tokens[second] SELECT FROM num => day _ CollectDay[d, month]; ENDCASE => Bogus[second]; GetThird[]; year _ CollectYear[t]}; num => { GetThird[]; WITH s: input.tokens[second] SELECT FROM alpha => { month _ ParseSymbolicMonth[s ! BogusMonth => Bogus[second]]; day _ CollectDay[f, month ! OutOfRange => GO TO yearFirst]; year _ CollectYear[t]; EXITS yearFirst => { year _ CollectYear[f]; day _ CollectDay[t, month]}}; num => { year _ CollectYear[t ! OutOfRange => GO TO yearFirst]; month _ CollectMonth[f ! OutOfRange => GO TO dayFirst]; day _ CollectDay[s, month]; EXITS yearFirst => { year _ CollectYear[f]; month _ CollectMonth[s]; day _ CollectDay[t, month]}; dayFirst => { month _ CollectMonth[s]; day _ CollectDay[f, month]}}; ENDCASE}; ENDCASE; next _ third + 1; EXIT ENDLOOP; IF month = 2 AND day = 29 AND ~LeapYear[year] THEN Bogus[next]; }; ParseTime: PROC [first: TokenIndex] RETURNS [next: TokenIndex] = { ENABLE OutOfRange => ERROR Unintelligible[errorPos]; CollectHour: PROC [h: num Token] RETURNS [Hour] = {RETURN[CollectValue[h, FIRST[Hour], LAST[Hour]]]}; CollectMinute: PROC [m: num Token] RETURNS [Minute] = INLINE {RETURN[CollectValue[m, FIRST[Minute], LAST[Minute]]]}; CollectSecond: PROC [s: num Token] RETURNS [Second] = INLINE {RETURN[CollectValue[s, FIRST[Second], LAST[Second]]]}; AMorPM: PROC [t: TokenIndex] RETURNS [BOOL] = { WITH m: input.tokens[t] SELECT FROM alpha => IF m.length = 2 AND Rope.Upper[r.Fetch[m.offset+1]] = 'M THEN { offset: Hour _ 0; SELECT Rope.Upper[r.Fetch[m.offset]] FROM 'A => offset _ 0; 'P => offset _ 12; ENDCASE => RETURN [FALSE]; IF ~(hour IN [1..12]) THEN Bogus[t]; hour _ (hour MOD 12) + offset; RETURN [TRUE]}; ENDCASE; RETURN [FALSE] }; n: num Token; next _ first + 1; hour _ minute _ second _ 0; WITH f: input.tokens[first] SELECT FROM num => n _ f; sep => IF f.char = sentinel THEN {notes _ noTime; RETURN} ELSE Bogus[first]; ENDCASE => Bogus[first]; SELECT n.length FROM 1, 2, 4, 6 => NULL; ENDCASE => Bogus[first]; hour _ CollectHour[[n.offset, num[MIN[n.length, 2]]]]; IF n.length <= 2 THEN { IF next + 1 >= input.nTokens OR input.tokens[next].type ~= sep THEN Bogus[next]; next _ next + 1; WITH s: input.tokens[next] SELECT FROM num => n _ s; ENDCASE => Bogus[next]; SELECT n.length FROM 2, 4 => next _ next + 1; ENDCASE => Bogus[next]} ELSE {n.offset _ n.offset + 2; n.length _ n.length - 2}; minute _ CollectMinute[[n.offset, num[2]]]; IF n.length > 2 THEN second _ CollectSecond[[n.offset+2, num[2]]] ELSE WITH sep: input.tokens[next] SELECT FROM sep => IF sep.char = ': THEN WITH s: input.tokens[next+1] SELECT FROM num => {second _ CollectSecond[s]; next _ next + 2}; ENDCASE => Bogus[next+1]; ENDCASE; WITH s: input.tokens[next] SELECT FROM sep => IF s.char ~= sentinel AND AMorPM[next+1] THEN next _ next + 2; alpha => IF AMorPM[next] THEN next _ next + 1; ENDCASE; }; ParseZone: PROC [first: TokenIndex] RETURNS [next: TokenIndex] = { ENABLE OutOfRange => ERROR Unintelligible[errorPos]; BadZone: ERROR = CODE; CollectSymbolic: PROC [z: alpha Token] = { char: CHARACTER = r.Fetch[z.offset]; SELECT z.length FROM 1 => { zones: PACKED ARRAY ZoneIndex OF CHARACTER = [ 'M, 'L, 'K, 'I, 'H, 'G, 'F, 'E, 'D, 'C, 'B, 'A, 'Z, 'N, 'O, 'P, 'Q, 'R, 'S, 'T, 'U, 'V, 'W, 'X, 'Y]; FOR hour: ZoneIndex IN ZoneIndex DO IF char = zones[hour] THEN {zoneAdjust _ hour*minutesPerHour; EXIT}; REPEAT FINISHED => GO TO badZone; ENDLOOP}; 3 => { naZones: PACKED ARRAY NAZones OF CHARACTER = [ 'B, 'H, 'Y, 'P, 'M, 'C, 'E, 'A]; IF Rope.Upper[r.Fetch[z.offset+2]] ~= 'T THEN GO TO badZone; SELECT Rope.Upper[r.Fetch[z.offset+1]] FROM 'S, 'M => NULL; -- treat "mean" same as "standard" 'D => dst _ TRUE; ENDCASE => GO TO badZone; SELECT char FROM 'G => IF dst THEN GO TO badZone; 'N => IF dst THEN GO TO badZone ELSE zoneAdjust _ -(3*minutesPerHour+30); ENDCASE => FOR hour: NAZones IN NAZones DO IF char = naZones[hour] THEN {zoneAdjust _ hour*minutesPerHour; EXIT}; REPEAT FINISHED => GO TO badZone; ENDLOOP}; ENDCASE => GO TO badZone; EXITS badZone => ERROR BadZone; }; CollectAbsolute: PROC [z: num Token] RETURNS [DeltaMinutes] = { hour: Hour; hourLength: NAT; minute: Minute _ 0; IF ~(z.length IN [1..4]) THEN ERROR OutOfRange[z.offset+z.length]; hourLength _ 2 - (z.length MOD 2); hour _ CollectValue[[z.offset, num[hourLength]], FIRST[Hour], LAST[Hour]]; IF z.length > 2 THEN minute _ CollectValue[[z.offset+hourLength, num[2]], FIRST[Minute], LAST[Minute]]; RETURN [hour*minutesPerHour+minute] }; zoneAdjust _ 0; dst _ FALSE; next _ first; IF notes = noTime THEN RETURN; WITH z: input.tokens[next] SELECT FROM sep => { zone: Token; SELECT z.char FROM Ascii.SP, '+, '- => zone _ input.tokens[next + 1]; ENDCASE => GO TO noZone; -- includes sentinel WITH zone: zone SELECT FROM num => SELECT z.char FROM Ascii.SP => GO TO noZone; '+ => zoneAdjust _ CollectAbsolute[zone]; '- => zoneAdjust _ -CollectAbsolute[zone]; ENDCASE; -- can't happen alpha => IF z.char = '+ THEN Bogus[next] ELSE CollectSymbolic[zone ! BadZone => IF z.char = Ascii.SP THEN GO TO noZone ELSE Bogus[next+1]]; ENDCASE; -- can't happen next _ next + 1}; alpha => CollectSymbolic[z ! BadZone => GO TO noZone]; ENDCASE => GO TO noZone; EXITS noZone => notes _ noZone; }; LeapYear: PROC [year: Year] RETURNS [BOOL] = { RETURN[year MOD 4 = 0 AND (year MOD 100 ~= 0 OR year MOD 400 = 0)]}; ConsumeSpace: PROC [t: TokenIndex] RETURNS [TokenIndex] = { WITH s: input.tokens[t] SELECT FROM sep => SELECT s.char FROM Ascii.SP, ', => RETURN[t+1]; ENDCASE; ENDCASE; RETURN[t] }; AssembleGMT: PROC RETURNS [BasicTime.GMT] = { DetermineZoneCorrection: PROC = { FirstSundayAfter: PROC [ed: EpochDays] RETURNS [EpochDays] = {RETURN [ed+7-((ed+baseDay) MOD 7)]}; ltp: System.LocalTimeParameters _ [direction: west, zone: 8, zoneMinutes: 0, beginDST: , endDST: ]; ltp _ System.GetLocalTimeParameters[ ! System.LocalTimeParametersUnknown => { notes _ IF notes = noZone THEN zoneGuessed ELSE timeAndZoneGuessed; CONTINUE}]; ltp.beginDST _ FirstSundayAfter[ epochToJan1 + --Apr23-- (112+(IF LeapYear[year] THEN 1 ELSE 0))] - epochToJan1; ltp.endDST _ FirstSundayAfter[ epochToJan1 + --Oct24-- (296+(IF LeapYear[year] THEN 1 ELSE 0))] - epochToJan1; zoneAdjust _ ltp.zone * minutesPerHour + ltp.zoneMinutes; IF ltp.direction = west THEN zoneAdjust _ - zoneAdjust; dst _ SELECT jan1ToDate FROM IN (ltp.beginDST..ltp.endDST) => TRUE, = ltp.beginDST => (hour >= 2), = ltp.endDST => (hour < 2), ENDCASE => FALSE; }; YearBoundaries: PROC [year: Year, span: NAT] RETURNS [NAT] = INLINE {RETURN[(year+span-1)/span - (FIRST[Year]+span-1)/span]}; epochToJan1: EpochDays _ (year - FIRST[Year])*365 + YearBoundaries[year, 4] - YearBoundaries[year, 100] + YearBoundaries[year, 400]; jan1ToDate: YearDays _ cumDays[month-1] + (day-1) - (IF ~LeapYear[year] AND month > 2 THEN 1 ELSE 0); IF notes ~= normal THEN DetermineZoneCorrection[]; RETURN [LOOPHOLE[ ((epochToJan1+jan1ToDate)+(System.gmtEpoch/secondsPerDay))*secondsPerDay + ((INT[hour]- (IF dst THEN 1 ELSE 0))*minutesPerHour+minute-zoneAdjust)*secondsPerMinute+ second]]; }; nextToken: TokenIndex _ SUCC[FIRST[TokenIndex]]; notes _ normal; BEGIN Tokenize[]; nextToken _ ParseDate[nextToken ! Unintelligible => GO TO tryTimeFirst]; nextToken _ ConsumeSpace[nextToken]; nextToken _ ParseTime[nextToken]; nextToken _ ParseZone[nextToken]; EXITS tryTimeFirst => { nextToken _ ParseTime[nextToken]; nextToken _ ParseZone[nextToken]; nextToken _ ConsumeSpace[nextToken]; nextToken _ ParseDate[nextToken]; }; END; dt _ AssembleGMT[]; length _ input.tokens[nextToken].offset; }; END. φDateAndTimeImpl.mesa last edited by Levin on June 22, 1983 10:38 am The following computation isn't exactly correct, since it doesn't account for the absence of leap days in century years not divisible by 400. As it happens, the actual values for baseYear and LAST[EpochDays] are such that there is only one such day, and it doesn't affect the arithmetic. If there are more than maxReasonableTokens, each subsequent call to this procedure will overwrite the last token stored. Eventually, the scan will complete and the final token will be a sentinel. The effect of the following is to ignore spaces as separators unless there is nothing else, and to terminate the scan if two separator characters are adjacent. We would like to catch a bounds fault here and turn it into OutOfRange. Unfortunately, the current implementation of catch phrases doesn't support this, since a catch phrase is only attached to procedure calls. Accordingly, we have to do the test by hand. The actual test is a bit too stringent, but it doesn't really matter. Assert: 'first' is alpha or num and at least two tokens follow it. Assert: 'second' is alpha or num. Ergo, second+1 < input.nTokens since input.tokens[input.nTokens-1].type = sep Assert: 'third' is alpha or num. If we are really processing a date, 'third' will have to be numeric to make sense. However, we might be processing something like Wednesday, 26 May 1981, in which there is a valid date, but 'first' isn't pointing to it yet (it's still on Wednesday). So, we don't check that 'third' is numeric until we are sure that 'first' is pointing to something reasonable. The first token is alpha. If it isn't a recognizable month, it might be some form of the day of the week. Whatever it is, we simply skip over it (and the separator following it, if any) and try again. 'first' corresponds to a valid month. We now require that 'second' be the day of the month and 'third' be the year. The second token is alpha, so we will require it to be the month. Now we must decide if we have or All three parts are numeric. Be sure we weren't slipped a bogus leap year... A separator must follow a 1- or 2- digit hour field. Assert: input.tokens[next+1] is alpha or num. Assert: 'next' indexes the token following the minutes. The minutes and seconds are concatenated. Now look for optional seconds field. We assume it is present if there is a colon separator following the minutes. Assert: input.tokens[next+1] is alpha or num. Assert: 'next' indexes the token following the last time part (minutes or seconds). We need to compute the local time parameters in effect at this zone on the date in question. Note that this is an imperfect simulation, since it assumes uniform dates and times for start and end of daylight savings time within the local zone. The following expression computes the number of years y in [FIRST[Year]..year) for which y MOD span is 0. The following gross arithmetic is required to avoid overflows. *** Main Body of Parse *** Assert: The input has been tokenized such that: input.tokens[0].kind = input.tokens[input.nTokens-1].kind = sep[sentinel]] for all i IN (0..input.nTokens-1): if input.tokens[i].type = sep, then input.tokens[i-1].type ~= sep and input.tokens[i+1].type ~= sep Κ– "cedar" style˜JšΟc™Jš.™.J˜šΟk ˜ Jšœžœžœžœ˜Jšœ žœžœ˜Jšœ žœ ˜Jšœžœžœ˜7šœžœ˜JšœS˜S—J˜—šœž˜Jšžœ ˜Jšžœ˜J˜—Jšž˜J˜Jš œžœž œ žœžœ˜9J˜Jšœ žœ˜Jšœžœ˜Jšœžœ˜Jšœžœ/˜AJšœ žœ˜Jšœ žœ ,˜EJ˜Jš œ žœžœžœžœžœ˜žœ˜EJšFœ-™tšžœžœž˜(J˜"Jšžœ˜—J˜ J˜—˜J˜ šžœžœž˜(˜ JšA™AJšœ<˜™>šžœžœ˜JšœJ˜Jšœžœ˜ Jšœžœžœžœ8˜K—Jšœ ˜ —J˜—J˜Jš™J˜Jšœžœžœ˜0J˜Jšž˜Jšœ ˜ Jš0™0JšL™LJš Ÿ™$Jš(™(JšG™GJšœ4žœžœ˜HJšœ$˜$Jšœ!˜!Jšœ!˜!šž˜šœ˜Jšœ!˜!Jšœ!˜!Jšœ$˜$Jšœ!˜!Jšœ˜——Jšžœ˜J˜J˜(J˜J˜—Jšžœ˜J˜—…—3€S³