<> <> 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}]; <<'first' corresponds to a valid month. We now require that 'second' be the day of the month and 'third' be the year.>> 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]]; < or >> 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]]; }; <<*** Main Body of Parse ***>> nextToken: TokenIndex _ SUCC[FIRST[TokenIndex]]; notes _ normal; BEGIN Tokenize[]; <> << 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>> 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.