IOScanImpl.mesa
Copyright Ó 1984, 1985, 1986, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) February 27, 1987 4:13:13 pm PST
Carl Hauser, February 16, 1988 3:22:38 pm PST
Eduardo Pelegri-Llopart December 5, 1988 2:29:49 pm PST
Michael Plass, October 17, 1991 1:31 pm PDT
Known Bug: GetToken flushes angle-bracket comments even if flushComments = FALSE.
Known Bug: SkipWhitespace does not know about angle-bracket comments.
DIRECTORY
Ascii USING [Lower],
BasicTime USING [GMT, OutOfRange, Pack, Unpacked],
Convert USING [AtomFromRope, BoolFromRope, CardFromDecimalLiteral, CardFromHexLiteral, CardFromOctalLiteral, CharFromLiteral, Error, IntFromRope, RealFromLiteral, RopeFromLiteral],
IO USING [Backup, BreakProc, CR, LF, EndOf, EndOfStream, Error, GetChar, GetUnpackedTime, NUL, SP, STREAM, TokenError, TokenKind],
RefText USING [InlineAppendChar, New, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Concat, Equal, FromRefText, ROPE, TextBound];
IOScanImpl: CEDAR PROGRAM
IMPORTS Ascii, BasicTime, Convert, IO, Rope, RefText
EXPORTS IO
= BEGIN
BreakProc: TYPE = IO.BreakProc;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
TokenError: TYPE = IO.TokenError;
TokenKind: TYPE = IO.TokenKind;
XeroxOtherDollar: CHAR = 244C; -- ¤
XeroxLeftAngle2: CHAR = 253C; -- «
XeroxLeftArrow: CHAR = 254C; -- ¬
XeroxUpArrow: CHAR = 255C; -- ­
XeroxMultiply: CHAR = 264C; -- ´
XeroxDivide: CHAR = 270C; -- ¸
XeroxRightAngle2: CHAR = 273C; -- »
GetToken, GetLine, SkipWhitespace
GetToken: PUBLIC PROC [stream: STREAM, breakProc: BreakProc, buffer: REF TEXT] RETURNS [token: REF TEXT, charsSkipped: INT] = {
quit, include: BOOL ¬ FALSE;
anySeen: BOOL ¬ FALSE;
charsSkipped ¬ 0;
buffer.length ¬ 0;
UNTIL quit OR (buffer.length > 0 AND IO.EndOf[stream]) DO
char: CHAR ~ IO.GetChar[stream];
SELECT breakProc[char] FROM
break => {include ¬ NOT anySeen; quit ¬ TRUE};
sepr => {include ¬ FALSE; quit ¬ anySeen };
other => {include ¬ TRUE; quit ¬ FALSE; anySeen ¬ TRUE};
ENDCASE => ERROR;
SELECT TRUE FROM
include => {buffer ¬ RefText.InlineAppendChar[buffer, char]};
quit => {stream.streamProcs.backup[stream, char]};
ENDCASE => charsSkipped ¬ charsSkipped + 1;
ENDLOOP;
RETURN[buffer, charsSkipped];
};
GetTokenRope: PUBLIC PROC [stream: STREAM, breakProc: BreakProc] RETURNS [token: ROPE, charsSkipped: INT] = {
buffer: REF TEXT = RefText.ObtainScratch[100];
{ ENABLE UNWIND => RefText.ReleaseScratch[buffer];
tokenText: REF TEXT;
[tokenText, charsSkipped] ¬ GetToken[stream, breakProc, buffer];
token ¬ Rope.FromRefText[tokenText];
};
RefText.ReleaseScratch[buffer];
RETURN [token, charsSkipped];
};
IDProc: PUBLIC BreakProc = {
RETURN[SELECT char FROM
IN [IO.NUL .. IO.SP] => sepr,
',, ':, '; => sepr,
ENDCASE => other];
};
TokenProc: PUBLIC BreakProc = {
RETURN [SELECT char FROM
'[, '], '(, '), '{, '}, '", '+, '-, '*, '/, '@, '← => break,
IN [IO.NUL .. IO.SP] => sepr,
',, ':, '; => sepr,
ENDCASE => other];
};
GetLine: PUBLIC PROC [stream: STREAM, buffer: REF TEXT] RETURNS [line: REF TEXT] = {
maxLen: Rope.TextBound = LAST[Rope.TextBound];
IF buffer = NIL THEN buffer ¬ RefText.New[100];
buffer.length ¬ 0;
{ ENABLE IO.EndOfStream => IF buffer.length > 0 THEN CONTINUE ELSE REJECT;
DO
char: CHAR ¬ IO.GetChar[stream];
IF char = IO.LF OR char = IO.CR OR buffer.length = maxLen THEN EXIT;
buffer ¬ RefText.InlineAppendChar[buffer, char];
ENDLOOP;
};
RETURN [buffer];
};
GetLineRope: PUBLIC PROC [stream: STREAM] RETURNS [line: ROPE ¬ NIL] = {
bufMax: NAT = 256;
buffer: REF TEXT = RefText.ObtainScratch[bufMax];
bLen: NAT ¬ 0;
chars: INT ¬ 0;
{ ENABLE IO.EndOfStream => IF chars > 0 THEN CONTINUE ELSE REJECT;
DO
char: CHAR ¬ IO.GetChar[stream];
IF (char = IO.LF) OR (char = IO.CR) THEN EXIT;
chars ¬ chars + 1;
IF bLen = bufMax THEN {
buffer.length ¬ bLen;
line ¬ Rope.Concat[line, Rope.FromRefText[buffer]];
bLen ¬ 0;
};
buffer[bLen] ¬ char;
bLen ¬ bLen+1;
ENDLOOP;
};
buffer.length ¬ bLen;
IF bLen # 0 THEN line ¬ Rope.Concat[line, Rope.FromRefText[buffer]];
RefText.ReleaseScratch[buffer];
RETURN [line];
};
SkipWhitespace: PUBLIC PROC [stream: STREAM, flushComments: BOOL] RETURNS [charsSkipped: INT ¬ 0] = {
char: CHAR;
charsSkipped ¬ 0;
DO
IF IO.EndOf[stream] THEN GO TO Done;
char ¬ IO.GetChar[stream];
SELECT char FROM
IN [IO.NUL .. IO.SP] => charsSkipped ¬ charsSkipped + 1;
'- => {
IF IO.EndOf[stream] OR NOT flushComments THEN EXIT;
char ¬ IO.GetChar[stream];
IF char # '-
THEN {
false alarm, first minus is not start of comment
stream.streamProcs.backup[stream, char];
char ¬ '-;
EXIT}
ELSE {
start of comment, consume rest of comment
charsSkipped ¬ charsSkipped + 2;
DO
IF IO.EndOf[stream] THEN GO TO Done;
char ¬ IO.GetChar[stream];
SELECT char FROM
IO.LF, IO.CR => EXIT;
'- => {
charsSkipped ¬ charsSkipped + 1;
IF IO.EndOf[stream] THEN GO TO Done;
char ¬ IO.GetChar[stream];
IF char = '- THEN EXIT;
};
ENDCASE => charsSkipped ¬ charsSkipped + 1;
ENDLOOP;
charsSkipped ¬ charsSkipped + 1;
};
};
ENDCASE => EXIT;
ENDLOOP;
stream.streamProcs.backup[stream, char];
EXITS Done => {};
};
GetCedarToken
GetCedarToken: PUBLIC PROC
[stream: STREAM, buffer: REF TEXT, flushComments: BOOL ¬ FALSE]
RETURNS [tokenKind: TokenKind, token: REF TEXT, charsSkipped: INT, error: TokenError] = {
char: CHAR ¬ 0C;
low: CHAR ¬ 0C;
Get: PROC RETURNS [eof: BOOL ¬ FALSE] = {
IF IO.EndOf[stream] THEN RETURN [TRUE];
char ¬ IO.GetChar[stream];
token ¬ RefText.InlineAppendChar[token, char];
low ¬ Ascii.Lower[char];
};
NextCharSkip: PROC RETURNS [CHAR] = INLINE {
No accumulation or lower casing necessary here
char ¬ IO.GetChar[stream];
charsSkipped ¬ charsSkipped + 1;
RETURN [char];
};
PutbackChar: PROC = {
stream.streamProcs.backup[stream, token[token.length ¬ token.length - 1]];
};
NOTE: the acceptance procs below return with no extra chars read in case of acceptance, and (with exception of AcceptHexTail) with the first erroneous char read in case of non-acceptance.
AcceptExtendedChar: PROC RETURNS [success: BOOL ¬ FALSE] = {
have seen '\\; looking for rest of extendedChar
IF Get[].eof THEN GO TO Failure;
SELECT low FROM
'n, 'r, 't, 'b, 'f, 'l, '\', '\", '\\ => RETURN[TRUE];
IN ['0..'9] => {
THROUGH [1..2] DO
IF Get[].eof THEN GO TO Failure;
IF char NOT IN ['0..'9] THEN GO TO Failure;
ENDLOOP;
RETURN[TRUE];
};
ENDCASE
EXITS Failure => { error ¬ $extendedChar; RETURN[FALSE] }
};
AcceptRealTail: PROC [] = {
have seen ?num.digit; looking for ?num?exponent
DO
IF Get[].eof THEN GO TO Accept;
SELECT low FROM
IN ['0..'9] => NULL;
'e => { [] ¬ AcceptExponent[]; RETURN };
ENDCASE => { PutbackChar[]; RETURN };
ENDLOOP;
EXITS Accept => RETURN
};
AcceptExponent: PROC RETURNS [success: BOOL] = {
have seen (E|e); looking for ?(+|-)num
IF Get[].eof THEN GO TO Failure;
SELECT low FROM
'-, '+ => IF Get[].eof THEN GO TO Failure;
ENDCASE => NULL;
IF char NOT IN ['0..'9] THEN GO TO Failure;
DO
IF Get[].eof THEN GO TO Success;
IF char NOT IN ['0..'9] THEN {
PutbackChar[]; GO TO Success
}
ENDLOOP;
EXITS
Success => RETURN [TRUE];
Failure => { error ¬ $numericLiteral; RETURN [FALSE] };
};
AcceptHexTail: PROC [] RETURNS [success: BOOL] = {
have seen num(A|a|B|b|C|c|D|d|E|e|F|f); looking for rest of hex constant
if not success then restore state, since may not be an error
length: NAT = token.length;
{
DO
IF Get[].eof THEN GO TO Undo;
SELECT low FROM
IN ['0..'9], IN ['a..'f] => NULL;
'h => EXIT;
ENDCASE => GO TO Undo;
ENDLOOP;
DO
IF Get[].eof THEN GO TO Accept;
IF char NOT IN ['0..'9] THEN EXIT;
ENDLOOP;
GO TO PutbackAccept;
EXITS
Accept => { tokenKind ¬ $tokenHEX; RETURN [TRUE] };
PutbackAccept => { PutbackChar[]; tokenKind ¬ $tokenHEX; RETURN [TRUE] };
Undo => {
FOR i: NAT DECREASING IN [length .. token.length) DO PutbackChar[] ENDLOOP;
token.length ¬ length;
RETURN [FALSE] }
}
};
AcceptAngleComment: PROC = {
state: {plain, leftBrocket, rightBrocket} ¬ plain;
nest: CARDINAL ¬ 1;
tokenKind ¬ $tokenCOMMENT;
DO
IF Get[].eof THEN ERROR IO.EndOfStream[stream];
IF flushComments THEN {charsSkipped ¬ charsSkipped + 1; token.length ¬ 0};
SELECT char FROM
'> => SELECT state FROM
plain, leftBrocket => state ¬ rightBrocket;
rightBrocket => IF nest = 1 THEN EXIT ELSE {state ¬ plain; nest ¬ nest - 1};
ENDCASE;
'< => SELECT state FROM
plain, rightBrocket => state ¬ leftBrocket;
leftBrocket => {state ¬ plain; nest ¬ nest + 1};
ENDCASE;
XeroxLeftAngle2 => {state ¬ plain; nest ¬ nest + 1};
« in the Xerox Character Code Standard
XeroxRightAngle2 => IF nest = 1 THEN EXIT ELSE {state ¬ plain; nest ¬ nest - 1};
» in the Xerox Character Code Standard
Ascii.CR purposely don't count lines here
ENDCASE => state ¬ plain;
ENDLOOP;
};
error ¬ $none;
token ¬ buffer;
token.length ¬ 0;
charsSkipped ¬ 0;
{
DO
token.length ¬ 0;
IF Get[].eof THEN GO TO EOFReturn;
SELECT low FROM
IN [IO.NUL .. IO.SP] => {
white space
charsSkipped ¬ charsSkipped + 1;
};
'- => {
minus or comment
prev: CHAR ¬ IO.CR;
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
IF char # '- THEN GO TO PutbackReturn;
tokenKind ¬ $tokenCOMMENT;
IF flushComments
THEN {
charsSkipped ¬ charsSkipped + 2; -- for the leading two dashes
DO
IF IO.EndOf[stream] THEN GO TO eof;
SELECT NextCharSkip[] FROM
IO.CR, IO.LF => EXIT;
'- => IF prev = '- THEN EXIT;
ENDCASE;
prev ¬ char;
ENDLOOP;
EXITS eof => {};
}
ELSE
DO
IF Get[].eof THEN GO TO Return;
SELECT char FROM
IO.CR, IO.LF => GO TO PutbackReturn;
Don't include the CR in the comment
'- => IF prev = '- THEN GO TO Return;
Must include the trailing dash in the comment
ENDCASE;
prev ¬ char;
ENDLOOP;
};
IN ['a .. 'z] => {
identifier
tokenKind ¬ $tokenID;
DO
IF Get[].eof THEN GO TO Return;
SELECT low FROM
IN ['a..'z], IN ['0..'9] => NULL;
ENDCASE => GO TO PutbackReturn;
ENDLOOP;
};
IN ['0 .. '9] => {
numeric literal, this gets hairy
tokenKind ¬ $tokenDECIMAL;
DO
IF Get[].eof THEN GO TO Return;
IF char NOT IN ['0..'9] THEN EXIT;
ENDLOOP;
SELECT low FROM
'. => {
IF Get[].eof THEN GO TO Invalid;
IF char IN ['0 .. '9]
THEN { -- REAL
tokenKind ¬ $tokenREAL;
AcceptRealTail[]; GO TO Return }
ELSE { -- DECIMAL followed by dotdot
PutbackChar[]; GO TO PutbackReturn }
};
'a, 'f => {
IF AcceptHexTail[] THEN GO TO Return ELSE GO TO Invalid;
};
'b, 'd => {
IF low = 'b THEN tokenKind ¬ $tokenOCTAL;
IF AcceptHexTail[] THEN GO TO Return;
DO
IF Get[].eof THEN GO TO Return;
IF char NOT IN ['0..'9] THEN EXIT;
ENDLOOP;
GO TO PutbackReturn;
};
'c => {
IF NOT AcceptHexTail[] THEN tokenKind ¬ $tokenCHAR;
GO TO Return;
};
'e => {
IF AcceptHexTail[] THEN GO TO Return;
IF AcceptExponent[]
THEN { tokenKind ¬ $tokenREAL; GO TO Return }
ELSE GO TO ErrorReturn;
};
'h => {
tokenKind ¬ $tokenHEX;
DO
IF Get[].eof THEN GO TO Return;
IF char NOT IN ['0..'9] THEN EXIT;
ENDLOOP;
GO TO PutbackReturn;
};
ENDCASE => GO TO PutbackReturn;
EXITS Invalid => { error ¬ $numericLiteral; GO TO ErrorReturn }
};
'. => {
either a dotdot or a REAL or a dot
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT char FROM
'. => GO TO DoubleReturn; -- dotdot
IN ['0..'9] => NULL; -- REAL
ENDCASE => GO TO PutbackReturn; -- dot
tokenKind ¬ $tokenREAL;
AcceptRealTail[];
GO TO Return;
};
',, ';, ':, '←, '#, '+, '/, '^, '@, '!, '(, '), '[, '], '{, '}, '|,
XeroxDivide, XeroxMultiply, XeroxLeftArrow, XeroxUpArrow =>
GO TO SingleReturn;
'* => {
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT char FROM
'* => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'~ => {
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT char FROM
'=, '<, '> => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'\' => {
CHAR literal
tokenKind ¬ $tokenCHAR;
IF Get[].eof THEN GO TO Illegal;
SELECT char FROM
'\\ => IF NOT AcceptExtendedChar[] THEN GO TO ErrorReturn ELSE GO TO Return;
IN [' ..'~], XeroxLeftArrow, XeroxUpArrow => GO TO Return;
ENDCASE => GO TO Illegal;
EXITS Illegal => { error ¬ $charLiteral; GO TO ErrorReturn };
};
'\" => {
ROPE, REF TEXT, or STRING literal
quoteSeen: BOOL ¬ FALSE;
tokenKind ¬ $tokenROPE;
DO
IF Get[].eof THEN {IF quoteSeen THEN GO TO Return ELSE GO TO Illegal};
SELECT low FROM
'\" => quoteSeen ¬ NOT quoteSeen;
'\\ => IF quoteSeen THEN EXIT
ELSE IF NOT AcceptExtendedChar[] THEN GO TO ErrorReturn;
IN [' ..'~], IO.LF, IO.CR, '\t, XeroxLeftArrow, XeroxUpArrow => IF quoteSeen THEN EXIT;
ENDCASE => GO TO Illegal;
ENDLOOP;
IF low = 'l THEN GO TO Return ELSE GO TO PutbackReturn;
EXITS Illegal => { error ¬ $stringLiteral; GO TO ErrorReturn };
};
'$, XeroxOtherDollar => {
ATOM literal
tokenKind ¬ $tokenATOM;
IF Get[].eof THEN GO TO BadAtom;
SELECT low FROM
IN ['a..'z] => {};
ENDCASE => GO TO BadAtom;
DO
IF Get[].eof THEN GO TO Return;
SELECT low FROM
IN ['a..'z], IN ['0..'9] => NULL;
ENDCASE => GO TO PutbackReturn;
ENDLOOP;
};
'= => {
either '=' or '=>'
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT low FROM
'> => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'> => {
either '>' or '>='
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT low FROM
'= => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'< => {
either '< or '<= or <<
tokenKind ¬ $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT low FROM
'= => GO TO DoubleReturn;
'< => AcceptAngleComment[! IO.EndOfStream => GO TO BadEOFReturn];
ENDCASE => GO TO PutbackReturn;
};
XeroxLeftAngle2 =>
AcceptAngleComment[! IO.EndOfStream => GO TO BadEOFReturn];
ENDCASE => {
error ¬ $singleChar;
GO TO ErrorReturn
};
ENDLOOP;
EXITS
Return => { RETURN };
PutbackReturn => { PutbackChar[]; RETURN };
SingleReturn => { tokenKind ¬ $tokenSINGLE; RETURN };
DoubleReturn => { tokenKind ¬ $tokenDOUBLE; RETURN };
BadAtom => { tokenKind ¬ $tokenERROR; error ¬ atomLiteral; RETURN };
BadEOFReturn => { tokenKind ¬ $tokenERROR; error ¬ singleChar; RETURN };
EOFReturn => { tokenKind ¬ $tokenEOF; RETURN };
ErrorReturn => { tokenKind ¬ $tokenERROR; RETURN };
}
};
GetCedarTokenRope: PUBLIC PROC [stream: STREAM, flushComments: BOOL] RETURNS [tokenKind: TokenKind, token: ROPE, charsSkipped: INT] = {
buffer: REF TEXT = RefText.ObtainScratch[100];
{ ENABLE UNWIND => RefText.ReleaseScratch[buffer];
tokenText: REF TEXT;
[tokenKind: tokenKind, token: tokenText, charsSkipped: charsSkipped] ¬
GetCedarToken[stream, buffer, flushComments];
SELECT tokenKind FROM
tokenEOF => ERROR IO.EndOfStream[stream];
tokenERROR => ERROR IO.Error[$SyntaxError, stream];
ENDCASE;
token ¬ Rope.FromRefText[tokenText];
};
RefText.ReleaseScratch[buffer];
RETURN [tokenKind, token, charsSkipped];
};
Get<Type>
GetInt: PUBLIC PROC [stream: STREAM] RETURNS [INT] = {
LastInt: LONG CARDINAL = INT.LAST;
card: LONG CARDINAL;
negative: BOOL;
[card, negative] ¬ GetNumber[stream, TRUE];
IF negative
THEN { IF card <= LastInt+1 THEN RETURN[-card] }
ELSE { IF card <= LastInt THEN RETURN[card] };
ERROR IO.Error[$Overflow, stream];
};
GetCard: PUBLIC PROC [stream: STREAM] RETURNS [LONG CARDINAL] = {
RETURN[GetNumber[stream, FALSE].card];
};
GetNumber: PUBLIC PROC [stream: STREAM, negativeOK: BOOL] RETURNS [card: LONG CARDINAL ¬ 0, negative: BOOL ¬ FALSE] = {
tokenKind: TokenKind; token: REF TEXT;
signSeen: BOOL ¬ FALSE;
buffer: REF TEXT = RefText.ObtainScratch[100];
negative ¬ FALSE;
{
ENABLE Convert.Error => IF reason = $overflow THEN GO TO Overflow;
Other conversion errors are detected by GetCedarToken.
DO -- executed once or twice
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenDECIMAL => {
card ¬ Convert.CardFromDecimalLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenOCTAL => {
card ¬ Convert.CardFromOctalLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenHEX => {
card ¬ Convert.CardFromHexLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenSINGLE => {
IF signSeen THEN GO TO SyntaxError;
signSeen ¬ TRUE;
SELECT token[0] FROM
'- => IF negativeOK THEN negative ¬ TRUE ELSE GO TO SyntaxError;
'+ => NULL;
ENDCASE => GO TO SyntaxError;
};
tokenEOF => IF signSeen THEN GO TO SyntaxError ELSE GO TO EndOfStream;
ENDCASE => GO TO SyntaxError;
ENDLOOP;
RefText.ReleaseScratch[buffer];
EXITS
EndOfStream => {
RefText.ReleaseScratch[buffer];
ERROR IO.EndOfStream[stream] };
SyntaxError => {
RefText.ReleaseScratch[buffer];
ERROR IO.Error[$SyntaxError, stream] };
Overflow => {
RefText.ReleaseScratch[buffer];
ERROR IO.Error[$Overflow, stream] };
};
};
GetReal: PUBLIC PROC [stream: STREAM] RETURNS [REAL] = {
tokenKind: TokenKind; token: REF TEXT;
signSeen, negative: BOOL ¬ FALSE;
real: REAL;
buffer: REF TEXT = RefText.ObtainScratch[100];
{
DO -- executed once or twice
Conversion errors are detected by GetCedarToken.
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenDECIMAL => {
real ¬ Convert.CardFromDecimalLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenOCTAL => {
real ¬ Convert.CardFromOctalLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenHEX => {
real ¬ Convert.CardFromHexLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenREAL => {
real ¬ Convert.RealFromLiteral[RefText.TrustTextAsRope[token]];
EXIT };
tokenSINGLE => {
IF signSeen THEN GO TO SyntaxError;
signSeen ¬ TRUE;
SELECT token[0] FROM
'- => negative ¬ TRUE;
'+ => NULL;
ENDCASE => GO TO SyntaxError;
};
tokenEOF => IF signSeen THEN GO TO SyntaxError ELSE GO TO EndOfStream;
ENDCASE => GO TO SyntaxError;
ENDLOOP;
RefText.ReleaseScratch[buffer];
RETURN [IF negative THEN -real ELSE real];
EXITS
EndOfStream => {
RefText.ReleaseScratch[buffer];
ERROR IO.EndOfStream[stream] };
SyntaxError => {
RefText.ReleaseScratch[buffer];
ERROR IO.Error[$SyntaxError, stream] };
};
};
GetTime: PUBLIC PROC [stream: STREAM] RETURNS [BasicTime.GMT] = {
RETURN[BasicTime.Pack[stream.GetUnpackedTime[]
! BasicTime.OutOfRange => ERROR IO.Error[$Overflow, stream]]];
};
GetBool: PUBLIC PROC [stream: STREAM] RETURNS [bool: BOOL] = {
tokenKind: TokenKind;
token: REF TEXT;
buffer: REF TEXT = RefText.ObtainScratch[100];
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenID => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
bool ¬ Convert.BoolFromRope[RefText.TrustTextAsRope[token] ! Convert.Error =>
IF reason = $syntax THEN ERROR IO.Error[$SyntaxError, stream]];
RefText.ReleaseScratch[buffer];
};
GetAtom: PUBLIC PROC [stream: STREAM] RETURNS [atom: ATOM] = {
tokenKind: TokenKind;
token: REF TEXT;
buffer: REF TEXT = RefText.ObtainScratch[100];
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenID => NULL;
tokenATOM => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
atom ¬ Convert.AtomFromRope[RefText.TrustTextAsRope[token] ! Convert.Error =>
IF reason = $syntax THEN ERROR IO.Error[$SyntaxError, stream]];
RefText.ReleaseScratch[buffer];
};
GetRopeLiteral: PUBLIC PROC [stream: STREAM] RETURNS [r: ROPE] = {
tokenKind: TokenKind;
token: REF TEXT;
buffer: REF TEXT = RefText.ObtainScratch[100];
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenROPE => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
r ¬ Convert.RopeFromLiteral[RefText.TrustTextAsRope[token]];
RefText.ReleaseScratch[buffer];
};
GetCharLiteral: PUBLIC PROC [stream: STREAM] RETURNS [c: CHAR] = {
tokenKind: TokenKind;
token: REF TEXT;
buffer: REF TEXT = RefText.ObtainScratch[100];
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenCHAR => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
c ¬ Convert.CharFromLiteral[RefText.TrustTextAsRope[token] ! Convert.Error =>
IF reason = $overflow THEN ERROR IO.Error[$Overflow, stream]];
RefText.ReleaseScratch[buffer];
};
GetID: PUBLIC PROC [stream: STREAM] RETURNS [r: ROPE] = {
tokenKind: TokenKind;
token: REF TEXT;
buffer: REF TEXT = RefText.ObtainScratch[100];
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenID => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
r ¬ Rope.FromRefText[token];
RefText.ReleaseScratch[buffer];
};
GetRefAny
GetRefAny: PUBLIC PROC [stream: STREAM] RETURNS [object: REF ¬ NIL] = {
RightParen: ERROR = CODE;
Comma: ERROR = CODE;
GetRefAny0: PROC [stream: STREAM, buffer: REF TEXT] RETURNS [REF] = {
ENABLE Convert.Error =>
IF reason = $syntax THEN ERROR IO.Error[$SyntaxError, stream]
ELSE IF reason = $overflow THEN ERROR IO.Error[$Overflow, stream];
tokenKind: IO.TokenKind;
token: REF TEXT;
DO
[tokenKind: tokenKind, token: token] ¬ GetCedarToken[stream, buffer, TRUE];
SELECT tokenKind FROM
tokenERROR => GO TO syntax;
tokenID => {
SELECT TRUE FROM
Rope.Equal[RefText.TrustTextAsRope[token], "NIL"] =>
RETURN [NIL];
Rope.Equal[RefText.TrustTextAsRope[token], "TRUE"] =>
RETURN[NEW[BOOL ¬ TRUE]];
Rope.Equal[RefText.TrustTextAsRope[token], "FALSE"] =>
RETURN[NEW[BOOL ¬ FALSE]];
ENDCASE => RETURN [Convert.AtomFromRope[RefText.TrustTextAsRope[token]]];
};
IN [tokenDECIMAL .. tokenHEX] => RETURN[
NEW[INT ¬ Convert.IntFromRope[RefText.TrustTextAsRope[token]]]];
tokenREAL => RETURN[
NEW[REAL ¬ Convert.RealFromLiteral[RefText.TrustTextAsRope[token]]]];
tokenROPE => RETURN[Convert.RopeFromLiteral[RefText.TrustTextAsRope[token]]];
tokenCHAR => RETURN[
NEW[CHAR ¬ Convert.CharFromLiteral[RefText.TrustTextAsRope[token]]]];
tokenATOM => RETURN[Convert.AtomFromRope[RefText.TrustTextAsRope[token]]];
tokenSINGLE => {
c: CHAR = token[0];
SELECT c FROM
'( => {
lst, tail: LIST OF REF ¬ NIL;
obj: REF;
UNTIL IO.EndOf[stream] DO
new: LIST OF REF ¬ NIL;
obj ¬ GetRefAny0[stream, buffer
! RightParen, IO.EndOfStream => EXIT; Comma => LOOP];
new ¬ LIST[obj];
IF tail # NIL THEN tail.rest ¬ new ELSE lst ¬ new;
tail ¬ new;
ENDLOOP;
RETURN[lst];
};
') => ERROR RightParen;
'^ => NULL; -- e.g. ­3, makes print and read be inverses.
', => ERROR Comma;
'-, '+ => {
obj: REF = GetRefAny0[stream, buffer];
WITH obj SELECT FROM
x: REF INT => IF c = '- THEN x­ ¬ -x­;
x: REF REAL => IF c = '- THEN x­ ¬ -x­;
ENDCASE => GO TO syntax;
RETURN[obj];
};
ENDCASE => GO TO syntax;
};
tokenDOUBLE => GO TO syntax;
tokenCOMMENT => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR;
ENDLOOP;
EXITS syntax => ERROR IO.Error[$SyntaxError, stream];
};
buffer: REF TEXT = RefText.ObtainScratch[100];
object ¬ GetRefAny0[stream, buffer
! RightParen, Comma => {
RefText.ReleaseScratch[buffer];
ERROR IO.Error[$SyntaxError, stream]}];
RefText.ReleaseScratch[buffer];
};
GetRefAnyLine: PUBLIC PROC [stream: STREAM] RETURNS [LIST OF REF] = {
lst, tail: LIST OF REF ¬ NIL;
lst ¬ tail ¬ LIST[GetRefAny[stream]];
UNTIL stream.EndOf[] DO
c: CHAR ~ stream.GetChar[];
IF (c = IO.CR) OR (c = IO.LF) THEN EXIT;
IF c#IO.SP THEN IO.Backup[stream, c];
tail.rest ¬ LIST[GetRefAny[stream]]; tail ¬ tail.rest;
ENDLOOP;
RETURN[lst];
};
END.
Russ Atkinson (RRA) February 6, 1986 5:21:11 pm PST
Eliminated bounds faults from GetLine, made GetLineRope return arbitrary length lines, minor cleanup to a couple of others, GetRefAny0 (local of GetRefAny), GetRefAnyLine
Eduardo Pelegri-Llopart December 5, 1988 2:29:34 pm PST
Treats CR and LF identically.
Michael Plass, August 3, 1991 0:11:24 am PDT
Removed many catch phrases.