

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: 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 {
stream.streamProcs.backup[stream, char];
char Ź '-;
EXIT}
ELSE {
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: 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 {
char Ź IO.GetChar[stream];
charsSkipped Ź charsSkipped + 1;
RETURN [char];
};
PutbackChar: PROC = {
stream.streamProcs.backup[stream, token[token.length Ź token.length - 1]];
};

AcceptExtendedChar: PROC RETURNS [success: BOOL Ź FALSE] = {
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 [] = {
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] = {
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] = {
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};
XeroxRightAngle2 => IF nest = 1 THEN EXIT ELSE {state Ź plain; nest Ź nest - 1};
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] => {
charsSkipped Ź charsSkipped + 1;
};
'- => {
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;
'- => IF prev = '- THEN GO TO Return;
ENDCASE;
prev Ź char;
ENDLOOP;
};
IN ['a .. 'z] => {
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] => {
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 }
};
'. => {
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;
};
'\' => {
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 };
};
'\" => {
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 => {
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;
};
'= => {
tokenKind Ź $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT low FROM
'> => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'> => {
tokenKind Ź $tokenSINGLE;
IF Get[].eof THEN GO TO Return;
SELECT low FROM
'= => GO TO DoubleReturn;
ENDCASE => GO TO PutbackReturn;
};
'< => {
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];
};
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;
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
[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: 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.

   ô  
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.
GetToken, GetLine, SkipWhitespace
false alarm, first minus is not start of comment
start of comment, consume rest of comment
GetCedarToken
No accumulation or lower casing necessary here
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.
have seen '\\; looking for rest of extendedChar
have seen ?num.digit; looking for ?num?exponent
have seen (E|e); looking for ?(+|-)num
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
Ť in the Xerox Character Code Standard
ť in the Xerox Character Code Standard
Ascii.CR purposely don't count lines here
white space
minus or comment
Don't include the CR in the comment
Must include the trailing dash in the comment
identifier
numeric literal, this gets hairy
either a dotdot or a REAL or a dot
CHAR literal
ROPE, REF TEXT, or STRING literal
ATOM literal
either '=' or '=>'
either '>' or '>='
either '< or '<= or <<
Get<Type>
Other conversion errors are detected by GetCedarToken.
Conversion errors are detected by GetCedarToken.
GetRefAny
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.

Ę&  (cedarcode) styleNewlineDelimiter
 codeK
ĎeCNK4K-K7K+K KQEEK Ďk		K	K
2K§´K7KIVK9K Đbl
K4K
KK KKKK!KK K3 in tabStopsĎn
Ďc$K3 in tabStops 
Ą#K3 in tabStops 
Ą"K3 in tabStops 
Ą K3 in tabStops 
Ą!K3 in tabStops 
ĄK3 in tabStops 
Ą$head!! 
 	
KK	KK	9K K.K+K	8KK==K22K$+KKKK  
	mK.#2KK@@K$$KKKKK  K

KKKK  	K<K

KKKK  

TK.K
/KJK KDK00KKK
KK  
HKK!1KKBK K		.KKK33K		KKKKKKK
4DKKKK  
	eKKK
$KK
%8K3K
K00K((K

KK))K  K
$KK
K  K
$KKKK$+KK  KKKKK((KK 	
´KK
 )K
'KK..KK
 ,K.KK  KK KJJKK Kťť
 <K//K	 K)6K	 K
	+KKKKK%9K K
   /KKK(K%KKK 0K
      &K	 K	
	*KK
	+K	 
KKKKK'8K 2K             "HK<<KKK!KKKKK

"KKK#3K9I		K
KKKKK K22KKK/K5JK++K	
"LKK++K00K44K&&	
"PK&&K!)KKKK KKKKKK"
KK  KKKKKK&KK"Ą?K
#K
KKKKKKK	$KĎz#	%K˘)-KKKKK

KKK!KKKK  KKK

"KK	 ĄĐckKK	!ĄŁĄ$K%KK	8KK
)K%KK

"KKKK3KKK%K	-KKKKK

"KKKKK(@KK	"KKKĄ	#KĄŁKĄ&KKKKKKKKKKKKK!KKKKK	 KLK+:K	K%>KK!KKK
FK!K8K'WK	KK
7K'@KKKK	 KK
KK!KKKKKKKKKKKKKKKKKKKKAKKK;KKKK	KK"+K,5K,5K;DK?HK'0K+4KKK  
K.#2KFFK--K)K3KK$$KKK"(K	 
6K		"KK
K%+	K	0K	.K"KK  
AK&KK  	
wK'K
K.KK

BK66ĄKEKKFFKKDDKKBBKK
#K
K@KKKK
FKKKKKKK'KK$KKK  
8K'K!KK.ĄK00KEKKFFKKDDKKBBKK??KK
#K
KKKKK
FKKKK
*KKKK'KKK  
A(.K>KK  
>KKK.KEKKK	)K0MMK@KKK  
>KKK.KEKKKK)K0MMK@KKK  
BKKK.KEKKK	)K0K<<KKK  
BKKK.KEKKK	)K0MMK>KKK  
9KKK.KEKKK	)K0KKK		 	

GKK 


EK=K
BKKKEKK44K55K66KK8IK(K9@K=EK:MK=EK7JKK	K	K	K5KK2KKKKKKĄĄ$9KK&K	
&K	
'KKKKKKKK)KKK5KK.""KK'KKK  
EK	K%KK(K
%K&6KKKIunit3KzĎr¤ŞK 7KK ,KK K      Rä  ß  