<> <> <> DIRECTORY Ascii USING [Lower], Atom USING [GetPName], AtomPrivate USING [UnsafeMakeAtom], Basics USING [LowHalf], BasicTime USING [GMT, Unpack, Unpacked, MonthOfYear, DayOfWeek, minutesPerHour], Convert, ConvertReal USING [AppendReal], IO, Real USING [RealException, PairToReal], RefText, Rope, RuntimeError; IOConvertImpl: CEDAR PROGRAM IMPORTS Ascii, Atom, AtomPrivate, Basics, BasicTime, ConvertReal, IO, Real, Rope, RefText, RuntimeError EXPORTS Convert SHARES Rope = BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Base: TYPE = [2..36]; RealPrecision: TYPE = Convert.RealPrecision; TimePrecision: TYPE = Convert.TimePrecision; ErrorType: TYPE = Convert.ErrorType; -- { syntax, overflow, empty } Error: PUBLIC ERROR [reason: ErrorType, index: INT] = CODE; <> CardFromDecimalLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [LONG CARDINAL] = { <<-- Accepts whitespaceChar...num?((d|D)?num)?whitespaceChar>> <<-- Note: does not accept a plus or minus sign>> rLength: INT = r.InlineLength[]; digitSeen: BOOL _ FALSE; num: LONG CARDINAL _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ r.InlineFetch[i]) FROM IN ['0..'9] => { IF num > (LCLAST-(10D-1))/10D AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/10D THEN ERROR Error[$overflow, i]; num _ num * 10D + (c.ORD-'0.ORD); digitSeen _ TRUE; }; 'D, 'd => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num _ ParseScaleFactor[10D, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN EXIT; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; IF NOT digitSeen THEN ERROR Error[$empty, rLength-1]; RETURN [num]; }; LCLAST: LONG CARDINAL = LAST[LONG CARDINAL]; ParseScaleFactor: PROC [base: NAT, accum: LONG CARDINAL, r: ROPE, index: INT] RETURNS [LONG CARDINAL] = { bound: LONG CARDINAL = LCLAST/base; scale: CARDINAL _ 0; c: CHAR; FOR i: INT IN [index+1..r.Length[]) DO IF (c _ r.Fetch[i]) IN ['0..'9] THEN { IF scale > (CARDINAL.LAST-9)/10 THEN ERROR Error[$overflow, i]; scale _ scale * 10 + (c.ORD-'0.ORD); } ELSE IF c IN [IO.NUL..IO.SP] THEN EXIT ELSE ERROR Error[$syntax, i]; ENDLOOP; UNTIL scale = 0 DO IF accum > bound THEN ERROR Error[$overflow, r.Length[]-1]; accum _ accum * base; scale _ scale - 1; ENDLOOP; RETURN [accum]; }; CardFromOctalLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [LONG CARDINAL] = { <<-- Accepts whitespaceChar...num(b|B)?num?whitespaceChar>> <<-- Note: does not accept a plus or minus sign, or a string of digits without radix char 'b>> rLength: INT = r.InlineLength[]; digitSeen: BOOL _ FALSE; num: LONG CARDINAL _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ r.InlineFetch[i]) FROM IN ['0..'7] => { IF num > (LCLAST-(10B-1))/10B AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/10B THEN ERROR Error[$overflow, i]; num _ num * 10B + (c.ORD-'0.ORD); digitSeen _ TRUE; }; 'B, 'b => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num _ ParseScaleFactor[10B, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN ERROR Error[$syntax, i]; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; ERROR Error[$empty, rLength-1]; }; CardFromHexLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [LONG CARDINAL] = { <<-- Accepts whitespaceChar...num(h|H)?num?whitespaceChar>> <<-- Note: does not accept a plus or minus sign, or a string of digits without radix char 'h>> rLength: INT = r.InlineLength[]; digitSeen: BOOL _ FALSE; num: LONG CARDINAL _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ Ascii.Lower[r.InlineFetch[i]]) FROM IN ['0..'9] => { IF num > (LCLAST-(10H-1))/10H AND num > (LCLAST-LOOPHOLE[(c.ORD-'0.ORD),CARDINAL])/10H THEN ERROR Error[$overflow, i]; num _ num * 10H + (c.ORD-'0.ORD); digitSeen _ TRUE; }; IN ['a..'f] => { IF num > (LCLAST-(10H-1))/10H AND num > (LCLAST-LOOPHOLE[c.ORD-(('a).ORD-10),CARDINAL])/10H THEN ERROR Error[$overflow, i]; num _ num * 10H + (c.ORD-(('a).ORD-10)); digitSeen _ TRUE; }; 'h => { IF NOT digitSeen THEN ERROR Error[$syntax, i]; IF i < rLength THEN num _ ParseScaleFactor[10H, num, r, i]; RETURN [num]; }; IN [IO.NUL..IO.SP] => IF digitSeen THEN ERROR Error[$syntax, i]; ENDCASE => ERROR Error[$syntax, i]; ENDLOOP; ERROR Error[$empty, rLength-1]; }; CardFromWholeNumberLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [LONG CARDINAL] = { rLength: INT = r.InlineLength[]; radixChar: CHAR _ 'd; FOR i: INT IN [start .. rLength) DO c: CHAR; SELECT (c _ Ascii.Lower[r.InlineFetch[i]]) FROM 'b, 'd, 'h => radixChar _ c; ENDCASE; ENDLOOP; RETURN [(SELECT radixChar FROM 'd => CardFromDecimalLiteral, 'b => CardFromOctalLiteral, 'h => CardFromHexLiteral ENDCASE => ERROR)[r, start]] }; RealFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [REAL] = { <> rLength: INT = r.InlineLength[]; State: TYPE = { initial, digitSeen, dotSeen, dotDigitSeen, eSeen, eDigitSeen }; state: State _ $initial; full: BOOL _ FALSE; mantissa: INT _ 0; mantissaExp: INTEGER _ 0; mantissaDigitsAfterDot: INTEGER _ 0; negativeExponent: BOOL _ FALSE; exp: INTEGER _ 0; i: INT; FOR i _ start, i+1 DO { c: CHAR; IF i = rLength THEN GOTO Done; SELECT (c _ r.InlineFetch[i]) FROM IN ['0..'9] => { SELECT state FROM $initial => state _ $digitSeen; $dotSeen => state _ $dotDigitSeen; ENDCASE; IF full OR ( mantissa > (INT.LAST-(10D-1))/10D AND mantissa > (INT.LAST-(c.ORD-'0.ORD))/10D) THEN { full _ TRUE; IF state = $digitSeen THEN mantissaExp _ mantissaExp + 1; } ELSE { mantissa _ mantissa * 10D + (c.ORD-'0.ORD); mantissaDigitsAfterDot _ mantissaDigitsAfterDot + 1; }; }; '. => SELECT state FROM $initial, $digitSeen => { mantissaDigitsAfterDot _ 0; state _ $dotSeen }; ENDCASE => GOTO Error; 'E, 'e => { SELECT state FROM $digitSeen => mantissaDigitsAfterDot _ 0; $dotDigitSeen => NULL; ENDCASE => GOTO Error; state _ $eSeen; IF (i _ i+1) = rLength THEN GOTO Error; SELECT (c _ r.Fetch[i]) FROM '-, '+ => { i _ i+1; negativeExponent _ c = '- }; ENDCASE; full _ FALSE; FOR i _ i, i+1 DO IF i = rLength THEN GOTO Done; SELECT (c _ r.InlineFetch[i]) FROM IN ['0..'9] => { state _ $eDigitSeen; IF full OR ( exp > (INTEGER.LAST-(10D-1))/10D AND exp > (INTEGER.LAST-(c.ORD-'0.ORD))/10D) THEN { full _ TRUE; } ELSE exp _ exp * 10D + (c.ORD-'0.ORD); }; IN [IO.NUL..IO.SP] => GOTO Done; ENDCASE => GOTO Error; ENDLOOP; }; IN [IO.NUL..IO.SP] => SELECT state FROM $initial => NULL; ENDCASE => GOTO Done; ENDCASE => GOTO Error; EXITS Error => ERROR Error[$syntax, i]; Done => SELECT state FROM $initial => ERROR Error[$empty, i]; $digitSeen, $dotSeen, $eSeen => ERROR Error[$syntax, i]; $dotDigitSeen, $eDigitSeen => EXIT; ENDCASE => ERROR; } ENDLOOP; { exponent: INT _ LONG[exp]; IF negativeExponent THEN exponent _ - exponent; exponent _ exponent + LONG[mantissaExp] - LONG[mantissaDigitsAfterDot]; exp _ IF exponent > INTEGER.LAST THEN INTEGER.LAST ELSE IF exponent < INTEGER.FIRST THEN INTEGER.FIRST ELSE LOOPHOLE[Basics.LowHalf[LOOPHOLE[exponent, LONG CARDINAL]], INTEGER]; RETURN[Real.PairToReal[mantissa, exp ! Real.RealException => RESUME [clientFixup: FALSE]]] } }; RopeFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [ROPE] = { new: ROPE; index: INT _ start + 1; end: INT _ r.InlineLength[]-1; resultChars: INT _ 0; escaped: BOOL _ FALSE; getProc: PROC RETURNS [c: CHAR] = { IF index > end THEN RETURN ['\000]; c _ r.InlineFetch[index]; index _ index + 1; SELECT c FROM '\\ => { [c, index] _ ParseEscapeCode[r, index]; escaped _ TRUE }; '\" => { IF r.Fetch[index] # '\" THEN ERROR Error[$syntax, index]; index _ index + 1; escaped _ TRUE }; ENDCASE; resultChars _ resultChars + 1; }; IF r.Fetch[start] # '\" THEN ERROR Error[$syntax, start]; SELECT r.Fetch[end] FROM 'l, 'L => { end _ end - 2; IF r.Fetch[end+1] # '\" THEN ERROR Error[$syntax, end]; }; '\" => end _ end - 1; ENDCASE => ERROR Error[$syntax, end]; new _ Rope.FromProc[end - index + 1, getProc]; IF escaped THEN new _ new.Substr[0, resultChars]; RETURN [new]; }; CharFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [CHAR] = { ENABLE RuntimeError.BoundsFault => ERROR Error[$syntax, start]; c: CHAR; SELECT (c _ r.Fetch[start]) FROM '\' => { -- preferred form: ' extendedChar IF (c _ r.Fetch[start _ start+1]) = '\\ THEN RETURN[ParseEscapeCode[r, start+1].c] ELSE RETURN[c]; }; IN ['0..'7] => { -- obsolete form: digit!...C num: INTEGER _ c.ORD-'0.ORD; DO SELECT (c _ r.Fetch[start _ start+1]) FROM IN ['0..'7] => { num _ num*10B + c.ORD-'0.ORD; IF num > 377B THEN ERROR Error[$overflow, start]; }; 'C, 'c => RETURN [VAL[num]]; ENDCASE => Error[$syntax, start]; ENDLOOP; }; ENDCASE => ERROR Error[$syntax, start]; }; ParseEscapeCode: PROC [r: ROPE, start: INT] RETURNS [c: CHAR, newIndex: INT] = { ENABLE RuntimeError.BoundsFault => ERROR Error[$syntax, start]; c _ r.Fetch[start]; SELECT Ascii.Lower[c] FROM 'n => c _ '\n; 'r => c _ '\r; 't => c _ '\t; 'b => c _ '\b; 'f => c _ '\f; 'l => c _ '\l; '\' => c _ '\'; '\" => c _ '\"; '\\ => c _ '\\; IN ['0..'3] => { num: INTEGER _ c.ORD-'0.ORD; FOR i: NAT IN [1..2] DO SELECT (c _ r.Fetch[start+i]) FROM IN ['0..'7] => num _ num*10B + c.ORD-'0.ORD; ENDCASE => ERROR Error[$syntax, start+i]; ENDLOOP; c _ VAL[num]; start _ start + 2; }; ENDCASE => ERROR Error[$syntax, start]; start _ start + 1; RETURN[c, start]; }; <<"Relaxed" parsing>> IntFromRope: PUBLIC PROC [r: ROPE, defaultBase: Base] RETURNS [INT] = { LastInt: LONG CARDINAL = INT.LAST; card: LONG CARDINAL; negative: BOOL; [card, negative] _ NumberFromRope[r, defaultBase, TRUE]; IF negative THEN { IF card <= LastInt+1 THEN RETURN[-card] } ELSE { IF card <= LastInt THEN RETURN[card] }; ERROR Error[$overflow, 0]; }; CardFromRope: PUBLIC PROC [r: ROPE, defaultBase: Base] RETURNS [LONG CARDINAL] = { RETURN[NumberFromRope[r, defaultBase, FALSE].card]; }; NumberFromRope: PROC [r: ROPE, defaultBase: Base, negativeOK: BOOL] RETURNS [card: LONG CARDINAL, negative: BOOL] = { <> rLength: INT = r.InlineLength[]; start: INT _ 0; base: NAT = defaultBase; State: TYPE = { initial, signSeen, digitSeen }; state: State _ $initial; num: LONG CARDINAL _ 0; negative _ FALSE; FOR i: INT IN [start..rLength) DO { c: CHAR; SELECT (c _ Ascii.Lower[r.InlineFetch[i]]) FROM IN ['0..'9] => { cNum: CARDINAL = LOOPHOLE[(c.ORD-'0.ORD),CARDINAL]; IF cNum >= base OR (num > (LCLAST-9)/10 AND num > (LCLAST-cNum)/base) THEN GOTO FindBase; num _ num * base + cNum; state _ $digitSeen; }; IN ['a..'z] => { cNum: CARDINAL = LOOPHOLE[c.ORD-('a.ORD-10),CARDINAL]; IF cNum >= base OR (num > (LCLAST-(Base.LAST-1))/Base.LAST AND num > (LCLAST-cNum)/base) THEN GOTO FindBase; num _ num * base + (c.ORD-('a.ORD-10)); state _ $digitSeen; }; '+, '- => IF state = $initial THEN { IF c = '- AND NOT negativeOK THEN GOTO Error; negative _ c = '-; start _ i+1; state _ $signSeen } ELSE GOTO Error; IN [IO.NUL..IO.SP] => IF state = $digitSeen THEN EXIT; ENDCASE => GOTO Error; EXITS FindBase => RETURN [CardFromWholeNumberLiteral[r, start], negative]; Error => ERROR Error[$syntax, i]; } ENDLOOP; SELECT state FROM initial, signSeen => ERROR Error[$empty, rLength]; ENDCASE => RETURN [num, negative]; }; RealFromRope: PUBLIC PROC [r: ROPE] RETURNS [REAL] = { rLength: INT = r.InlineLength[]; start: INT _ 0; result: REAL; signSeen: BOOL _ FALSE; negative: BOOL _ FALSE; FOR i: INT IN [start..rLength) DO { c: CHAR; SELECT (c _ Ascii.Lower[r.InlineFetch[i]]) FROM IN ['0..'9], '. => { start _ i; EXIT }; '+, '- => IF NOT signSeen THEN { negative _ c = '-; start _ i+1; EXIT } ELSE GOTO Error; IN [IO.NUL..IO.SP] => NULL; ENDCASE => GOTO Error; EXITS Error => ERROR Error[$syntax, i]; } ENDLOOP; result _ RealFromLiteral[r, start]; RETURN [IF negative THEN -result ELSE result]; }; TimeFromRope: PUBLIC PROC [r: ROPE] RETURNS [BasicTime.GMT] = { RETURN [IO.GetTime[IO.RIS[r] ! IO.Error => SELECT ec FROM $SyntaxError => ERROR Error[$syntax, stream.GetIndex[]]; $Overflow => ERROR Error[$overflow, stream.GetIndex[]]; ENDCASE]]; }; UnpackedTimeFromRope: PUBLIC PROC [r: ROPE] RETURNS [BasicTime.Unpacked] = { RETURN [IO.GetUnpackedTime[IO.RIS[r] ! IO.Error => IF ec = $SyntaxError THEN ERROR Error[$syntax, stream.GetIndex[]]]]; }; BoolFromRope: PUBLIC PROC [r: ROPE] RETURNS [BOOL] = { IF MatchPrefix[r, "true"] THEN RETURN [TRUE]; IF MatchPrefix[r, "false"] THEN RETURN [FALSE]; IF MatchPrefix[r, "yes"] THEN RETURN [TRUE]; IF MatchPrefix[r, "no"] THEN RETURN [FALSE]; ERROR Error[$syntax, 0]; }; MatchPrefix: PROC [r: ROPE, pat: Rope.Text] RETURNS [BOOL] = { patLen: INT = pat.Length[]; fail: BOOL _ patLen = 0; index: INT _ 0; match: PROC [c: CHAR] RETURNS [quit: BOOL] = { IF index < patLen THEN { IF pat.QFetch[index] = Ascii.Lower[c] THEN index _ index+1 ELSE fail _ TRUE; RETURN [quit: fail] } ELSE IF c IN [IO.NUL..IO.SP] THEN RETURN [quit: TRUE]; }; [] _ r.Map[action: match]; RETURN [NOT fail]; }; AtomFromRope: PUBLIC PROC [r: ROPE] RETURNS [ATOM] = { rLength: INT = r.InlineLength[]; result: ATOM; start: INT _ 0; IF start >= rLength THEN ERROR Error[$syntax, start]; IF r.Fetch[start] = '$ THEN start _ start+1; { scratch: REF TEXT = RefText.ObtainScratch[rLength-start]; len: NAT _ rLength-start; FOR i: NAT IN [0 .. len) DO scratch[i] _ r.InlineFetch[start+i]; ENDLOOP; scratch.length _ len; TRUSTED { result _ AtomPrivate.UnsafeMakeAtom[LOOPHOLE[scratch]] }; RefText.ReleaseScratch[scratch]; }; RETURN [result]; }; <> AppendInt: PUBLIC PROC [to: REF TEXT, from: INT, base: Base, showRadix: BOOL] RETURNS [REF TEXT] = { RETURN[AppendWholeNumber[to, LOOPHOLE[from.ABS], base, from<0, showRadix]]; }; AppendCard: PUBLIC PROC [to: REF TEXT, from: LONG CARDINAL, base: Base, showRadix: BOOL] RETURNS [REF TEXT] = { RETURN[AppendWholeNumber[to, from, base, FALSE, showRadix]]; }; AppendWholeNumber: PROC [ to: REF TEXT, from: LONG CARDINAL, base: NAT, negative: BOOL, showRadix: BOOL] RETURNS [REF TEXT] = { stack: ARRAY [0..31] OF CHAR; nChars: NAT _ 0; IF showRadix THEN { SELECT base FROM 10 => NULL; 8, 16 => { stack[0] _ IF base = 8 THEN 'B ELSE 'H; nChars _ 1 }; ENDCASE => ERROR Error[$invalidBase, 0]; } ELSE IF base NOT IN [2..36] THEN ERROR Error[$invalidBase, 0]; DO digit: NAT _ from MOD base; stack[nChars] _ VAL[IF digit < 10 THEN '0.ORD + digit ELSE 'A.ORD + (digit-10)]; nChars _ nChars + 1; IF from < base THEN EXIT; from _ from / base; ENDLOOP; IF negative THEN { stack[nChars] _ '-; nChars _ nChars + 1; }; to _ RefText.InlineReserveChars[to, nChars]; { newLengthMinusOne: NAT = to.length + nChars - 1; FOR i: NAT DECREASING IN [0 .. nChars) DO to[newLengthMinusOne-i] _ stack[i]; ENDLOOP; to.length _ newLengthMinusOne + 1; }; RETURN[to]; }; AppendReal: PUBLIC PROC [to: REF TEXT, from: REAL, precision: RealPrecision, useE: BOOL _ FALSE] RETURNS [REF TEXT] = TRUSTED { s: STRING _ [50]; toLength: NAT; ConvertReal.AppendReal[s, from, precision, useE]; to _ RefText.InlineReserveChars[to, s.length]; toLength _ to.length; FOR i: NAT IN [0 .. s.length) DO to[toLength+i] _ s[i]; ENDLOOP; to.length _ toLength + s.length; RETURN[to]; }; AppendTime: PUBLIC PROC [to: REF TEXT, from: BasicTime.GMT, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [REF TEXT] = { RETURN[AppendUnpackedTime[ to, BasicTime.Unpack[from], start, end, includeDayOfWeek, useAMPM, includeZone]]; }; AppendUnpackedTime: PUBLIC PROC [to: REF TEXT, from: BasicTime.Unpacked, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [REF TEXT] = { ok: PACKED ARRAY TimePrecision OF BOOL _ ALL[FALSE]; FOR p: TimePrecision IN TimePrecision[start..end] DO ok[p] _ TRUE ENDLOOP; IF includeDayOfWeek THEN { to _ RefText.AppendTextRope[to, Day[from.weekday]]; IF ok # ALL[FALSE] THEN to _ RefText.AppendTextRope[to, ", "] }; IF ok[months] THEN { to _ RefText.AppendTextRope[to, Month[from.month]]; IF ok[days] OR ok[years] OR ok[hours] THEN to _ RefText.AppendChar[to, ' ] }; IF ok[days] THEN { to _ AppendCard[to, from.day, 10, FALSE]; IF ok[years] OR ok[hours] THEN to _ RefText.AppendTextRope[to, ", "] }; IF ok[years] THEN { to _ AppendCard[to, from.year, 10, FALSE]; IF ok[hours] THEN to _ RefText.AppendChar[to, ' ] }; IF ok[hours] THEN { to _ AppendCard[ to, IF useAMPM AND from.hour>12 THEN from.hour - 12 ELSE from.hour, 10, FALSE]; IF ok[minutes] THEN { to _ RefText.AppendChar[to, ':]; IF from.minute < 10 THEN to _ RefText.AppendChar[to, '0]; to _ AppendCard[to, from.minute, 10, FALSE]; IF ok[seconds] THEN { to _ RefText.AppendChar[to, ':]; IF from.second < 10 THEN to _ RefText.AppendChar[to, '0]; to _ AppendCard[to, from.second, 10, FALSE]; }; }; IF useAMPM THEN to _ RefText.AppendTextRope[to, IF from.hour >= 12 THEN " pm" ELSE " am"]; IF includeZone THEN { dst: BOOL = from.dst = yes; zoneRope: ROPE _ NIL; SELECT from.zone FROM 0 => IF ~dst THEN zoneRope _ "GMT"; NAT[5*BasicTime.minutesPerHour] => zoneRope _ IF dst THEN "EDT" ELSE "EST"; NAT[6*BasicTime.minutesPerHour] => zoneRope _ IF dst THEN "CDT" ELSE "CST"; NAT[7*BasicTime.minutesPerHour] => zoneRope _ IF dst THEN "MDT" ELSE "MST"; NAT[8*BasicTime.minutesPerHour] => zoneRope _ IF dst THEN "PDT" ELSE "PST"; ENDCASE; IF zoneRope = NIL THEN zoneRope _ IO.PutFR["%g%02d%02d", IO.char[IF from.zone < 0 THEN '- ELSE '+], IO.card[from.zone.ABS/BasicTime.minutesPerHour], IO.card[from.zone.ABS MOD BasicTime.minutesPerHour] ]; to _ RefText.AppendChar[to, ' ]; to _ RefText.AppendRope[to, zoneRope]; }; }; RETURN[to]; }; Month: ARRAY BasicTime.MonthOfYear[January .. December] OF Rope.Text = [ "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]; Day: ARRAY BasicTime.DayOfWeek[Monday .. Sunday] OF Rope.Text = [ "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"]; AppendBool: PUBLIC PROC [to: REF TEXT, from: BOOL] RETURNS [REF TEXT] = { RETURN [RefText.AppendTextRope[to, Bool[from]]]; }; Bool: ARRAY BOOL OF Rope.Text = [TRUE: "TRUE", FALSE: "FALSE"]; AppendAtom: PUBLIC PROC [to: REF TEXT, from: ATOM, quote: BOOL] RETURNS [REF TEXT] = { pName: Rope.Text = IF from = NIL THEN "" ELSE Atom.GetPName[from]; IF quote THEN { CheckID[pName]; to _ RefText.AppendChar[to, '$]; }; RETURN [RefText.AppendTextRope[to, pName]]; }; CheckID: PUBLIC PROC [id: Rope.Text] = { FOR i: INT IN [0..id.InlineLength[]) DO SELECT id.QFetch[i] FROM IN ['0..'9] => IF i = 0 THEN ERROR Error[$unprintableAtom, 0]; IN ['A..'Z], IN ['a..'z] => NULL; ENDCASE => ERROR Error[$unprintableAtom, 0]; ENDLOOP; }; AppendRope: PUBLIC PROC [to: REF TEXT, from: ROPE, quote: BOOL _ TRUE] RETURNS [REF TEXT] = { IF quote THEN to _ RefText.InlineAppendChar[to, '\"]; FOR i: INT IN [0 .. from.InlineLength[]) DO c: CHAR = from.InlineFetch[i]; IF c IN [IO.SP .. IO.DEL) AND c # '\\ AND c # '\" AND c # '\' THEN to _ RefText.InlineAppendChar[to, c] ELSE to _ AppendExtendedChar[to, c]; ENDLOOP; IF quote THEN to _ RefText.InlineAppendChar[to, '\"]; RETURN [to]; }; AppendChar: PUBLIC PROC [to: REF TEXT, from: CHAR, quote: BOOL _ TRUE] RETURNS [REF TEXT] = { IF quote THEN to _ RefText.InlineAppendChar[to, '\']; RETURN [ IF from IN [IO.SP .. IO.DEL) AND from # '\\ AND from # '\" AND from # '\' THEN RefText.InlineAppendChar[to, from] ELSE AppendExtendedChar[to, from] ]; }; AppendExtendedChar: PROC [to: REF TEXT, c: CHAR] RETURNS [REF TEXT] = { IF c IN [IO.SP .. IO.DEL) THEN { IF c = '\\ OR c = '\" OR c = '\' THEN to _ RefText.AppendChar[to, '\\]; to _ RefText.AppendChar[to, c]; } ELSE { to _ RefText.AppendChar[to, '\\]; SELECT c FROM '\n => to _ RefText.AppendChar[to, 'n]; '\t => to _ RefText.AppendChar[to, 't]; '\b => to _ RefText.AppendChar[to, 'b]; '\f => to _ RefText.AppendChar[to, 'f]; '\l => to _ RefText.AppendChar[to, 'l]; ENDCASE => { to _ RefText.AppendChar[to, VAL['0.ORD + (c.ORD / 64)]]; to _ RefText.AppendChar[to, VAL['0.ORD + (c.ORD MOD 64 / 8)]]; to _ RefText.AppendChar[to, VAL['0.ORD + (c.ORD MOD 8)]] } ; }; RETURN [to]; }; RopeFromInt: PUBLIC PROC [from: INT, base: Base, showRadix: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendInt[scratch, from, base, showRadix]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromCard: PUBLIC PROC [from: LONG CARDINAL, base: Base, showRadix: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendCard[scratch, from, base, showRadix]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromReal: PUBLIC PROC [from: REAL, precision: RealPrecision, useE: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendReal[scratch, from, precision, useE]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromTime: PUBLIC PROC [from: BasicTime.GMT, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendUnpackedTime[scratch, BasicTime.Unpack[from], start, end, includeDayOfWeek, useAMPM, includeZone]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromUnpackedTime: PUBLIC PROC [from: BasicTime.Unpacked, start, end: TimePrecision, includeDayOfWeek, useAMPM, includeZone: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[100]; result: Rope.Text = Rope.FromRefText[AppendUnpackedTime[scratch, from, start, end, includeDayOfWeek, useAMPM, includeZone]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromBool: PUBLIC PROC [from: BOOL] RETURNS [Rope.Text] = { RETURN [Bool[from]]; }; RopeFromAtom: PUBLIC PROC [from: ATOM, quote: BOOL] RETURNS [ROPE] = { pName: Rope.Text = IF from = NIL THEN "" ELSE Atom.GetPName[from]; IF NOT quote THEN RETURN [pName]; CheckID[pName]; RETURN [Rope.Concat["$", pName]]; }; RopeFromRope: PUBLIC PROC [from: ROPE, quote: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[from.Length[]+10]; result: Rope.Text = Rope.FromRefText[AppendRope[scratch, from, quote]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; RopeFromChar: PUBLIC PROC [from: CHAR, quote: BOOL] RETURNS [Rope.Text] = { scratch: REF TEXT = RefText.ObtainScratch[5]; result: Rope.Text = Rope.FromRefText[AppendChar[scratch, from, quote]]; RefText.ReleaseScratch[scratch]; RETURN [result]; }; END.