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;
Parsing Cedar literals
CardFromDecimalLiteral:
PUBLIC
PROC [r:
ROPE, start:
INT]
RETURNS [
CARD] = {
Accepts whitespaceChar...num?((d|D)?num)?whitespaceChar
Note: does not accept a plus or minus sign
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] = {
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.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] = {
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.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] ~ {
Accepts both whitespaceChar...num exponent?whitespaceChar and whitespaceChar...?num.num?exponent?whitespaceChar, where exponent is (E|e)?(+|-)num
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] = {
Accepts whitespaceChar...?(+|-)whitespaceChar...number?whitespaceChar where number is digit... or a decimal, octal, or hex literal.
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];
};
Printing
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 "<NIL>" 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 "<NIL>" 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];
};
Real formatting
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 {
The answer is small enough to be considered 0.
buffer ← RefText.AppendChar[buffer, '0];
GO TO restZero};
IF fract < 0
THEN {
buffer ← RefText.AppendChar[buffer, '-];
fract ← -fract;
};
{
This is the more normal case. The trick here is to get the proper # of digits after the decimal point.
temp: REF TEXT ← RefText.ObtainScratch[afterDot+Real.MaxSinglePrecision+4];
tpos: NAT ← 0;
card: CARD ← fract;
error: {up, none, down} ← none;
First, adjust the number to be "aligned" with the buffer
DO
SELECT places+exp10
FROM
< 0 => {
card has too much precision, so eliminate one digit
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 => {
fract has too little precision, so accum a '0
temp[tpos] ← '0;
tpos ← tpos + 1;
places ← places - 1;
IF places = 0 THEN {temp[tpos] ← '.; tpos ← tpos + 1};
};
ENDCASE => EXIT;
ENDLOOP;
Next, put chars into the temp buffer in reverse order (the convenient order when peeling them off of a number).
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;
Finally, append the temporary buffer onto the output buffer
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 {
Too large for F format, so use E format
buffer ← AppendE[buffer, r, precision];
GO TO done};
Remove extra 0s to determine whether we can use F format
WHILE LowHalf[fract
MOD 10] = 0
DO
places ← places - 1;
exp10 ← exp10 + 1;
fract ← fract / 10;
ENDLOOP;
IF exp10 >= 0
THEN {
Can use F format, and only show 1 0 (to show that it's real)
buffer ← AppendF[buffer, r, 1];
GO TO done};
IF -exp10 <= precision
THEN {
Can use F format, but use places determined by the exponent
buffer ← AppendF[buffer, r, -exp10];
GO TO done};
Sigh, default to using E format
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];
};