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;
Parsing Cedar literals
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] = {
Accepts both whitespaceChar...num exponent?whitespaceChar and whitespaceChar...?num.num?exponent?whitespaceChar, where exponent is (E|e)?(+|-)num
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] = {
Accepts whitespaceChar...?(+|-)whitespaceChar...number?whitespaceChar where number is digit... or a decimal, octal, or hex literal.
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];
};
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:
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 "<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.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 "<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];
};
END.