<> <> <> <> DIRECTORY Ascii USING [Lower], Atom USING [GetPName], AtomPrivate USING [UnsafeMakeAtom], Basics USING [CARD, LongNumber, LowHalf], BasicTime USING [GMT, Unpack, Unpacked, MonthOfYear, DayOfWeek, minutesPerHour], Convert USING [ErrorType, RealPrecision, TimePrecision], IO USING [card, char, DEL, Error, GetIndex, GetTime, GetUnpackedTime, NUL, PutChar, PutFR, RIS, SP, STREAM], Real USING [MaxSinglePrecision, NumberType, PairToReal, RealException, RealToPair], RefText USING [AppendChar, AppendRope, AppendTextRope, ObtainScratch, ReleaseScratch, ReserveChars], Rope USING [ActionType, Concat, Fetch, FromProc, FromRefText, Length, Map, QFetch, ROPE, Substr, Text], RuntimeError USING [BoundsFault]; IOConvertImpl: CEDAR PROGRAM IMPORTS Ascii, Atom, AtomPrivate, Basics, BasicTime, IO, Real, Rope, RefText, RuntimeError EXPORTS Convert SHARES Rope = BEGIN OPEN Basics; 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 [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL _ FALSE; num: CARD _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ r.Fetch[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: CARD = LAST[CARD]; ParseScaleFactor: PROC [base: NAT, accum: CARD, r: ROPE, index: INT] RETURNS [CARD] = { bound: CARD = 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 [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL _ FALSE; num: CARD _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ r.Fetch[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 [CARD] = { <> <> rLength: INT = r.Length[]; digitSeen: BOOL _ FALSE; num: CARD _ 0; FOR i: INT IN [start..rLength) DO c: CHAR; SELECT (c _ Ascii.Lower[r.Fetch[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 [CARD] = { rLength: INT = r.Length[]; radixChar: CHAR _ 'd; FOR i: INT IN [start .. rLength) DO c: CHAR; SELECT (c _ Ascii.Lower[r.Fetch[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] ~ { <> state: {begin, int, dot, frac, estart, esign, exp, error} _ begin; index: INT _ start; -- index in rope of current char fr: INT _ 0; -- mantissa exp, adj: INTEGER _ 0; -- exponent and adjustment eNeg: BOOL _ FALSE; mDigits, eDigits: NAT _ 0; -- significant digits MDigit: PROC[c: CHAR] ~ { d: [0..10) ~ c-'0; IF state=frac THEN adj _ adj-1; IF mDigits=0 AND d=0 THEN NULL -- leading zero ELSE IF mDigits<9 THEN { fr _ fr*10+d; mDigits _ mDigits+1 } ELSE { adj _ adj+1; IF mDigits=9 AND d>5 THEN fr _ fr+1; }; -- round if 10th digit >5 }; EDigit: PROC[c: CHAR] ~ { d: [0..10) ~ c-'0; IF eDigits=0 AND d=0 THEN NULL -- leading zero ELSE IF eDigits<3 THEN { exp _ exp*10+d; eDigits _ eDigits+1 } ELSE ERROR Error[reason: $overflow, index: index]; }; action: Rope.ActionType ~ { SELECT state FROM begin => SELECT c FROM IN['\000..' ] => NULL; -- leading white space IN['0..'9] => { state _ int; MDigit[c] }; '. => state _ dot; ENDCASE => GOTO Fail; int => SELECT c FROM -- ?( + | - ) 0..9 | int 0..9 IN['0..'9] => MDigit[c]; '. => state _ frac; 'e, 'E => state _ estart; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; dot => SELECT c FROM -- ?( + | - ) . IN['0..'9] => { state _ frac; MDigit[c] }; ENDCASE => GOTO Fail; frac => SELECT c FROM -- int . | ?( + | - ) . 0..9 | frac 0..9 IN['0..'9] => MDigit[c]; 'e, 'E => state _ estart; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; estart => SELECT c FROM -- ( int | frac ) ( E | e ) IN['0..'9] => { state _ exp; EDigit[c] }; '+, '- => { eNeg _ (c='-); state _ esign }; ENDCASE => GOTO Fail; esign => SELECT c FROM -- ( int | frac ) ( E | e ) ( + | - ) IN['0..'9] => { state _ exp; EDigit[c] }; ENDCASE => GOTO Fail; exp => SELECT c FROM -- ( int | frac ) ( E | e ) ?( + | - ) 0..9 | exp 0..9 IN['0..'9] => EDigit[c]; IN['\000..' ] => RETURN[TRUE]; ENDCASE => GOTO Fail; ENDCASE => GOTO Fail; index _ index+1; EXITS Fail => { state _ error; RETURN[TRUE] }; }; [] _ Rope.Map[base: r, start: start, action: action]; SELECT state FROM int, frac, exp => NULL; -- ok begin => ERROR Error[reason: $empty, index: index]; ENDCASE => ERROR Error[reason: $syntax, index: index]; IF eNeg THEN exp _ -exp; RETURN[Real.PairToReal[fr: fr, exp10: exp+adj ! Real.RealException => RESUME]]; }; RopeFromLiteral: PUBLIC PROC [r: ROPE, start: INT] RETURNS [ROPE] = { new: ROPE; index: INT _ start + 1; end: INT _ r.Length[]-1; resultChars: INT _ 0; escaped: BOOL _ FALSE; getProc: PROC RETURNS [c: CHAR] = { IF index > end THEN RETURN ['\000]; c _ r.Fetch[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: CARD = INT.LAST; card: CARD; 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 [CARD] = { RETURN[NumberFromRope[r, defaultBase, FALSE].card]; }; NumberFromRope: PROC [r: ROPE, defaultBase: Base, negativeOK: BOOL] RETURNS [card: CARD, negative: BOOL] = { <> rLength: INT = r.Length[]; start: INT _ 0; base: NAT = defaultBase; State: TYPE = { initial, signSeen, digitSeen }; state: State _ $initial; num: CARD _ 0; negative _ FALSE; FOR i: INT IN [start..rLength) DO { c: CHAR; SELECT (c _ Ascii.Lower[r.Fetch[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.Length[]; 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.Fetch[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.Length[]; 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.Fetch[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: CARD, base: Base _ 10, showRadix: BOOL _ FALSE] RETURNS [REF TEXT] = { RETURN[AppendWholeNumber[to, from, base, FALSE, showRadix]]; }; AppendWholeNumber: PROC [ to: REF TEXT, from: CARD, 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.ReserveChars[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 { IF useE THEN RETURN [AppendE[to, from, precision]] ELSE RETURN [AppendG[to, from, precision]]; }; 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, RopeFromBool[from]]]; }; 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.Length[]) 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.AppendChar[to, '\"]; FOR i: INT IN [0 .. from.Length[]) DO to _ AppendChar[to, Rope.Fetch[from, i], FALSE]; ENDLOOP; IF quote THEN to _ RefText.AppendChar[to, '\"]; RETURN [to]; }; AppendChar: PUBLIC PROC [to: REF TEXT, from: CHAR, quote: BOOL _ TRUE] RETURNS [REF TEXT] = { IF quote THEN to _ RefText.AppendChar[to, '\']; RETURN [ IF from IN [IO.SP .. IO.DEL) AND from # '\\ AND from # '\" AND from # '\' THEN RefText.AppendChar[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: CARD, 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 [IF from THEN "TRUE" ELSE "FALSE"]; }; 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]; }; <> <<>> bufferSize: NAT = Real.MaxSinglePrecision*2 + 8; FtoRope: PUBLIC PROC [r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT _ RefText.ObtainScratch[bufferSize]; rope _ Rope.FromRefText[AppendF[scratch, r, afterDot]]; RefText.ReleaseScratch[scratch]; }; AppendF: PUBLIC PROC [buffer: REF TEXT, r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; places: INTEGER _ afterDot; [nType, fract, exp10] _ Real.RealToPair[r, Real.MaxSinglePrecision]; SELECT nType FROM normal => { fudge: REAL _ Real.PairToReal[5, -places-1]; abs: REAL _ ABS[r]; IF abs < fudge THEN { <> buffer _ RefText.AppendChar[buffer, '0]; GO TO restZero}; IF fract < 0 THEN { buffer _ RefText.AppendChar[buffer, '-]; fract _ -fract; }; { <> temp: REF TEXT _ RefText.ObtainScratch[afterDot+Real.MaxSinglePrecision+4]; tpos: NAT _ 0; card: CARD _ fract; error: {up, none, down} _ none; <> DO SELECT places+exp10 FROM < 0 => { <> thisDigit: [0..10) _ LowHalf[card MOD 10]; card _ card/10; exp10 _ exp10 + 1; SELECT thisDigit FROM = 0 => {}; > 5 => {card _ card + 1; error _ up}; = 5 => IF error = up THEN error _ down ELSE {card _ card + 1; error _ up}; ENDCASE => error _ down; }; > 0 => { <> temp[tpos] _ '0; tpos _ tpos + 1; places _ places - 1; IF places = 0 THEN {temp[tpos] _ '.; tpos _ tpos + 1}; }; ENDCASE => EXIT; ENDLOOP; <> DO temp[tpos] _ '0 + LowHalf[card MOD 10]; tpos _ tpos + 1; card _ card / 10; exp10 _ exp10 + 1; places _ places - 1; IF places = 0 THEN {temp[tpos] _ '.; tpos _ tpos + 1}; IF card = 0 AND exp10 > 0 THEN EXIT; ENDLOOP; <> WHILE tpos > 0 DO buffer _ RefText.AppendChar[buffer, temp[tpos _ tpos - 1]]; ENDLOOP; RefText.ReleaseScratch[temp]; }; }; zero => { buffer _ RefText.AppendChar[buffer, '0]; GO TO restZero; }; infinity => buffer _ RefText.AppendRope[buffer, IF fract < 0 THEN "-Inf" ELSE "+Inf"]; nan => { buffer _ RefText.AppendChar[buffer, '*]; buffer _ RefText.AppendChar[buffer, '.]; buffer _ AppendChars[buffer, afterDot, '*]; }; ENDCASE => ERROR; RETURN [buffer]; EXITS restZero => { IF afterDot > 0 THEN { buffer _ RefText.AppendChar[buffer, '.]; buffer _ AppendChars[buffer, afterDot, '0]}; RETURN [buffer]; }; }; EtoRope: PUBLIC PROC [r: REAL, afterDot: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT _ RefText.ObtainScratch[bufferSize]; rope _ Rope.FromRefText[AppendE[scratch, r, afterDot]]; RefText.ReleaseScratch[scratch]; }; AppendE: PUBLIC PROC [buffer: REF TEXT, r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; IF precision < 1 THEN precision _ 1; [nType, fract, exp10] _ Real.RealToPair[r, precision]; SELECT nType FROM normal => { abs: REAL _ ABS[r]; lag: CARD _ 1; card: CARD _ ABS[fract]; pos: NAT _ 0; IF r < 0.0 THEN buffer _ RefText.AppendChar[buffer, '-]; pos _ buffer.length; buffer _ RefText.AppendChar[buffer, '.]; buffer _ AppendWholeNumber[buffer, card, 10, FALSE, FALSE]; buffer[pos] _ buffer[pos+1]; buffer[pos+1] _ '.; buffer _ RefText.AppendChar[buffer, 'e]; exp10 _ exp10 + precision - 1; buffer _ RefText.AppendChar[buffer, IF exp10 < 0 THEN '- ELSE '+]; buffer _ AppendWholeNumber[buffer, ABS[exp10], 10, FALSE, FALSE]; }; ENDCASE => buffer _ AppendF[buffer, r, 1]; RETURN [buffer]; }; GtoRope: PUBLIC PROC [r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [rope: ROPE] = { scratch: REF TEXT _ RefText.ObtainScratch[bufferSize]; rope _ Rope.FromRefText[AppendG[scratch, r, precision]]; RefText.ReleaseScratch[scratch]; }; AppendG: PUBLIC PROC [buffer: REF TEXT, r: REAL, precision: [0..Real.MaxSinglePrecision]] RETURNS [REF TEXT] = { nType: Real.NumberType; <<{normal, zero, infinity, nan}>> fract: INT; exp10: INTEGER; IF precision < 1 THEN precision _ 1; [nType, fract, exp10] _ Real.RealToPair[r, precision]; SELECT nType FROM normal => { places: NAT _ precision; IF fract < 0 THEN { buffer _ RefText.AppendChar[buffer, '-]; fract _ ABS[fract]; r _ ABS[r]; }; IF exp10 > 0 THEN { <> buffer _ AppendE[buffer, r, precision]; GO TO done}; <> WHILE LowHalf[fract MOD 10] = 0 DO places _ places - 1; exp10 _ exp10 + 1; fract _ fract / 10; ENDLOOP; IF exp10 >= 0 THEN { <> buffer _ AppendF[buffer, r, 1]; GO TO done}; IF -exp10 <= precision THEN { <> buffer _ AppendF[buffer, r, -exp10]; GO TO done}; <> buffer _ AppendE[buffer, r, MAX[places, 2]]; EXITS done => {}; }; ENDCASE => buffer _ AppendF[buffer, r, 1]; RETURN [buffer]; }; PutChars: PROC [st: STREAM, chars: NAT, char: CHAR] = { THROUGH [0..chars) DO IO.PutChar[st, char]; ENDLOOP; }; AppendChars: PROC [text: REF TEXT, chars: NAT, char: CHAR] RETURNS [REF TEXT] = { THROUGH [0..chars) DO text _ RefText.AppendChar[text, char]; ENDLOOP; RETURN [text]; }; END.