<<>>
    <<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.>>
    <<>>