IOScanImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
MBrown on January 13, 1984 2:35 pm
Maxwell on September 1, 1983 3:50 pm
Paul Rovner on May 20, 1983 5:05 pm
Teitelman on April 6, 1983 3:46 pm
Russ Atkinson on November 7, 1984 12:06:40 pm PST
IOScanImpl:
CEDAR
PROGRAM
IMPORTS Ascii, BasicTime, Convert, IO, Rope, RefText
EXPORTS IO
= BEGIN
STREAM: TYPE = IO.STREAM;
ROPE: TYPE = Rope.ROPE;
BreakProc: TYPE = IO.BreakProc;
TokenKind: TYPE = IO.TokenKind;
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;
DO
char:
CHAR ←
stream.GetChar[ ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT];
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]; IF quit THEN EXIT};
quit => {stream.Backup[char]; EXIT};
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] = {
buffer.length ← 0;
DO
char:
CHAR ←
stream.GetChar[ ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT];
IF char # IO.CR THEN buffer ← RefText.InlineAppendChar[buffer, char] ELSE EXIT;
ENDLOOP;
RETURN [buffer];
};
GetLineRope:
PUBLIC
PROC [stream:
STREAM]
RETURNS [line:
ROPE] = {
buffer: REF TEXT = RefText.ObtainScratch[100];
{
ENABLE
UNWIND => RefText.ReleaseScratch[buffer];
line ← Rope.FromRefText[GetLine[stream, buffer]];
};
RefText.ReleaseScratch[buffer];
RETURN [line];
};
SkipWhitespace:
PUBLIC
PROC [stream:
STREAM, flushComments:
BOOL]
RETURNS [charsSkipped: INT] = {
char: CHAR;
{
charsSkipped ← 0;
DO
char ← stream.GetChar[ ! IO.EndOfStream => GOTO End];
SELECT char
FROM
IN [IO.NUL .. IO.SP] => charsSkipped ← charsSkipped + 1;
'- => {
IF NOT flushComments THEN GOTO Backup;
char ← stream.GetChar[ ! IO.EndOfStream => {stream.Backup[char]; GOTO End}];
IF char # '-
THEN {
-- false alarm, first minus is not start of comment
stream.Backup[char]; char ← '-; GOTO Backup }
ELSE {
-- start of comment, consume rest of comment
charsSkipped ← charsSkipped + 2;
DO
SELECT (char ← stream.GetChar[ !
IO.EndOfStream =>
GOTO End])
FROM
'\n => EXIT;
'- => {
charsSkipped ← charsSkipped + 1;
IF stream.GetChar[ ! IO.EndOfStream => GOTO End] = '- THEN EXIT;
};
ENDCASE => charsSkipped ← charsSkipped + 1;
ENDLOOP;
charsSkipped ← charsSkipped + 1;
};
};
ENDCASE => GOTO Backup;
ENDLOOP;
EXITS
Backup => { stream.Backup[char]; RETURN [charsSkipped] };
End => RETURN [charsSkipped];
}};
GetCedarToken
GetCedarToken:
PUBLIC
PROC [stream:
STREAM, buffer:
REF
TEXT, flushComments:
BOOL ← FALSE]
RETURNS [tokenKind: TokenKind, token: REF TEXT, charsSkipped: INT, error: IO.TokenError] = {
char: CHAR;
NextChar:
PROC
RETURNS [
CHAR] = {
char ← stream.GetChar[];
token ← RefText.InlineAppendChar[token, char];
RETURN[Ascii.Lower[char]]
};
PutbackChar:
PROC = {
stream.Backup[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] = {
have seen '\\; looking for rest of extendedChar
ENABLE IO.EndOfStream => GOTO Failure;
SELECT NextChar[]
FROM
'n, 'r, 't, 'b, 'f, 'l, '\', '\", '\\ => RETURN[TRUE];
IN ['0..'9] => {
THROUGH [1..2] DO IF NextChar[] NOT IN ['0..'9] THEN GOTO Failure ENDLOOP;
RETURN[TRUE];
};
ENDCASE
EXITS Failure => { error ← $extendedChar; RETURN[FALSE] }
};
AcceptRealTail:
PROC [] = {
have seen ?num.digit; looking for ?num?exponent
DO
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Accept]
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
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Failure]
FROM
'-, '+ => [] ← NextChar[ ! IO.EndOfStream => GOTO Failure];
ENDCASE => NULL;
IF char NOT IN ['0..'9] THEN GOTO Failure;
DO
IF NextChar[ !
IO.EndOfStream =>
GOTO Success]
NOT
IN ['0..'9]
THEN {
PutbackChar[]; GOTO 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
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Undo]
FROM
IN ['0..'9], IN ['a..'f] => NULL;
'h => EXIT;
ENDCASE => GOTO Undo;
ENDLOOP;
WHILE NextChar[ ! IO.EndOfStream => GOTO Accept] IN ['0..'9] DO ENDLOOP;
GOTO 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] }
}
};
error ← $none;
token ← buffer;
token.length ← 0;
charsSkipped ← 0;
{ -- EXITS ErrorReturn, DoubleReturn, Return, PutbackReturn, EOFReturn
DO
-- first arm loops, second may loop; others terminate
SELECT NextChar[ !
IO.EndOfStream =>
GOTO EOFReturn]
FROM
IN [
IO.
NUL ..
IO.
SP] => {
-- white space
charsSkipped ← charsSkipped + 1; token.length ← 0;
};
'- => {
-- minus or comment
prev: CHAR ← IO.CR;
endOfComment: BOOL ← FALSE;
tokenKind ← $tokenSINGLE;
IF NextChar[ ! IO.EndOfStream => GOTO Return] # '- THEN GOTO PutbackReturn;
tokenKind ← $tokenCOMMENT;
IF flushComments
THEN {
charsSkipped ← charsSkipped + 1; token.length ← 0 };
DO
{
SELECT NextChar[ !
IO.EndOfStream =>
GOTO EndOfStream]
FROM
IO.CR => endOfComment ← TRUE;
'- => IF prev = '- THEN endOfComment ← TRUE;
ENDCASE;
IF flushComments
THEN {
charsSkipped ← charsSkipped + 1; token.length ← 0 };
EXITS EndOfStream => endOfComment ← TRUE
};
IF endOfComment THEN IF flushComments THEN EXIT ELSE GOTO Return;
prev ← char;
ENDLOOP;
};
IN ['a .. 'z] => {
-- identifier
tokenKind ← $tokenID;
DO
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Return]
FROM
IN ['a..'z], IN ['0..'9] => NULL;
ENDCASE => GOTO PutbackReturn;
ENDLOOP;
};
IN ['0 .. '9] => {
-- numeric literal, this gets hairy
tokenKind ← $tokenDECIMAL;
WHILE NextChar[ ! IO.EndOfStream => GOTO Return] IN ['0..'9] DO ENDLOOP;
SELECT Ascii.Lower[char]
FROM
'. => {
IF NextChar[ !
IO.EndOfStream =>
GOTO Invalid]
IN ['0 .. '9]
THEN {
--
REAL
tokenKind ← $tokenREAL;
AcceptRealTail[]; GOTO Return }
ELSE {
--
DECIMAL followed by dotdot
PutbackChar[]; GOTO PutbackReturn }
};
'a, 'f => {
IF AcceptHexTail[] THEN GOTO Return ELSE GOTO Invalid;
};
'b, 'd => {
IF Ascii.Lower[char] = 'b THEN tokenKind ← $tokenOCTAL;
IF AcceptHexTail[] THEN GOTO Return;
WHILE NextChar[ ! IO.EndOfStream => GOTO Return] IN ['0..'9] DO ENDLOOP;
GOTO PutbackReturn;
};
'c => {
IF AcceptHexTail[] THEN GOTO Return;
tokenKind ← $tokenCHAR; GOTO Return;
};
'e => {
IF AcceptHexTail[] THEN GOTO Return;
IF AcceptExponent[] THEN { tokenKind ← $tokenREAL; GOTO Return }
ELSE GOTO ErrorReturn;
};
'h => {
tokenKind ← $tokenHEX;
WHILE NextChar[ ! IO.EndOfStream => GOTO Return] IN ['0..'9] DO ENDLOOP;
GOTO PutbackReturn;
};
ENDCASE => GOTO PutbackReturn;
EXITS Invalid => { error ← $numericLiteral; GOTO ErrorReturn }
};
'. => {
-- either a dotdot or a
REAL or a dot
tokenKind ← $tokenSINGLE;
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Return]
FROM
'. => GOTO DoubleReturn; -- dotdot
IN ['0..'9] => NULL; -- REAL
ENDCASE => GOTO PutbackReturn; -- dot
tokenKind ← $tokenREAL;
AcceptRealTail[]; GOTO Return;
};
',, ';, ':, '←, '#, '~, '+, '*, '/, '^, '@, '!, '(, '), '[, '], '{, '}, '| => {
tokenKind ← $tokenSINGLE; GOTO Return
};
'\' => {
--
CHAR literal
tokenKind ← $tokenCHAR;
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Illegal]
FROM
'\\ => IF NOT AcceptExtendedChar[] THEN GOTO ErrorReturn ELSE GOTO Return;
IN [' ..'~] => GOTO Return;
ENDCASE => GOTO Illegal;
EXITS Illegal => { error ← $charLiteral; GOTO ErrorReturn };
};
'\" => {
--
ROPE,
REF TEXT, or
STRING literal
quoteSeen: BOOL ← FALSE;
tokenKind ← $tokenROPE;
DO
SELECT NextChar[ !
IO.EndOfStream =>
IF quoteSeen
THEN
GOTO Return
ELSE
GOTO Illegal]
FROM
'\" => quoteSeen ← NOT quoteSeen;
'\\ =>
IF quoteSeen
THEN
EXIT
ELSE IF NOT AcceptExtendedChar[] THEN GOTO ErrorReturn;
IN [' ..'~], '\n, '\t => IF quoteSeen THEN EXIT;
ENDCASE => GOTO Illegal;
ENDLOOP;
SELECT Ascii.Lower[char]
FROM
'l => GOTO Return;
ENDCASE => GOTO PutbackReturn;
EXITS Illegal => { error ← $stringLiteral; GOTO ErrorReturn };
};
'$ => {
--
ATOM literal
tokenKind ← $tokenATOM;
{
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Invalid]
FROM
IN ['a..'z] => NULL;
ENDCASE => GOTO Invalid;
EXITS Invalid => { error ← $atomLiteral; GO TO ErrorReturn };
};
DO
SELECT NextChar[ !
IO.EndOfStream =>
GOTO Return]
FROM
IN ['a..'z], IN ['0..'9] => NULL;
ENDCASE => GOTO PutbackReturn;
ENDLOOP;
};
'= => {
-- either '=' or '=>'
tokenKind ← $tokenSINGLE;
IF NextChar[ ! IO.EndOfStream => GOTO Return] = '> THEN GOTO DoubleReturn
ELSE GOTO PutbackReturn
};
'>, '< => {
-- either '>' or '>=' (or '<' or '<=')
tokenKind ← $tokenSINGLE;
IF NextChar[ ! IO.EndOfStream => GOTO Return] = '= THEN GOTO DoubleReturn
ELSE GOTO PutbackReturn
};
ENDCASE => {
error ← $singleChar; GOTO ErrorReturn
};
ENDLOOP;
EXITS
Return => { RETURN };
PutbackReturn => { PutbackChar[]; RETURN };
DoubleReturn => { tokenKind ← $tokenDOUBLE; 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, negative: BOOL] = {
tokenKind: TokenKind; token: REF TEXT;
signSeen: BOOL ← FALSE;
buffer: REF TEXT = RefText.ObtainScratch[100];
negative ← FALSE;
{
ENABLE Convert.Error =>
IF reason = $overflow
THEN
GOTO 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 GOTO SyntaxError;
signSeen ← TRUE;
SELECT token[0]
FROM
'- => IF negativeOK THEN negative ← TRUE ELSE GOTO SyntaxError;
'+ => NULL;
ENDCASE => GOTO SyntaxError;
};
tokenEOF => IF signSeen THEN GOTO SyntaxError ELSE GOTO EndOfStream;
ENDCASE => GOTO SyntaxError;
ENDLOOP;
RefText.ReleaseScratch[buffer];
RETURN [card, negative];
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 GOTO SyntaxError;
signSeen ← TRUE;
SELECT token[0]
FROM
'- => negative ← TRUE;
'+ => NULL;
ENDCASE => GOTO SyntaxError;
};
tokenEOF => IF signSeen THEN GOTO SyntaxError ELSE GOTO EndOfStream;
ENDCASE => GOTO 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 [
REF
ANY] = {
RightParen: ERROR = CODE;
Comma: ERROR = CODE;
GetRefAny0:
PROC [stream:
STREAM, buffer:
REF
TEXT]
RETURNS [
REF
ANY] = {
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 => ERROR IO.Error[$SyntaxError, stream];
tokenID =>
RETURN[
IF Rope.Equal[RefText.TrustTextAsRope[token], "NIL"] THEN NIL
ELSE
IF Rope.Equal[RefText.TrustTextAsRope[token], "TRUE"]
THEN
NEW[BOOL ← TRUE]
ELSE
IF Rope.Equal[RefText.TrustTextAsRope[token], "FALSE"]
THEN
NEW[BOOL ← FALSE]
ELSE 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 ANY ← NIL;
obj: REF ANY;
UNTIL
IO.EndOf[stream]
DO
obj ← GetRefAny0[stream, buffer !
RightParen, IO.EndOfStream => EXIT; Comma => LOOP];
IF tail # NIL THEN {tail.rest ← LIST[obj]; tail ← tail.rest}
ELSE {tail ← LIST[obj]; lst ← tail};
ENDLOOP;
RETURN[lst];
};
') => ERROR RightParen;
'^ => NULL; -- e.g. ^3, makes print and read be inverses.
', => ERROR Comma;
'-, '+ =>
{obj: REF ANY = GetRefAny0[stream, buffer];
WITH obj
SELECT
FROM
x: REF INT => IF c = '- THEN x^ ← -x^;
x: REF REAL => IF c = '- THEN x^ ← -x^;
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
RETURN[obj];
};
ENDCASE => ERROR IO.Error[$SyntaxError, stream];
};
tokenDOUBLE => ERROR IO.Error[$SyntaxError, stream];
tokenCOMMENT => NULL;
tokenEOF => ERROR IO.EndOfStream[stream];
ENDCASE => ERROR;
ENDLOOP;
};
object: REF ANY;
buffer: REF TEXT = RefText.ObtainScratch[512];
{
object ← GetRefAny0[stream, buffer !
RightParen => ERROR IO.Error[$SyntaxError, stream];
Comma => ERROR IO.Error[$SyntaxError, stream]];
};
RefText.ReleaseScratch[buffer];
RETURN [object];
};
GetRefAnyLine:
PUBLIC
PROC [stream:
STREAM]
RETURNS [
LIST
OF
REF
ANY] = {
lst, tail: LIST OF REF ANY ← NIL;
lst ← tail ← LIST[GetRefAny[stream]];
UNTIL stream.EndOf[]
DO
IF stream.PeekChar[] = IO.CR THEN { [] ← stream.GetChar[]; EXIT };
tail.rest ← LIST[GetRefAny[stream]]; tail ← tail.rest;
ENDLOOP;
RETURN[lst];
};
END.