<<>>
    <<SchemeScannerImpl.mesa>>
        <<Copyright Ó 1989, 1990, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Last changed by Pavel on April 24, 1990 11:48 am PDT>>
        <<Last tweaked by Mike Spreitzer May 12, 1992 11:37 am PDT>>

    <<The implementation of the scanner used by the Cedar Scheme reader.>>
    <<>>
    DIRECTORY
        Ascii USING [CR, FF, LF, Lower, SP, TAB],
        Atom USING [GetPName, MakeAtom, MakeAtomFromChar, MakeAtomFromRefText],
        BigCardinals USING [BigAdd, BigCARD, BigFromCard, BigFromSmall, BigZero, BigMultiply, MultiplyByDigit, Zero],
        FS USING [StreamOpen],
        IO,
        RefText USING [AppendChar, ObtainScratch, ReleaseScratch, TrustTextAsRope],
        Rope,
        Scheme,
        SchemeExtras,
        SymTab USING [Create, Fetch, Ref, Store];

    SchemeScannerImpl: CEDAR PROGRAM
    IMPORTS Ascii, Atom, BigCardinals, FS, IO, RefText, Rope, Scheme, SymTab
    EXPORTS SchemeExtras
    ~ BEGIN OPEN Scheme, SchemeExtras;

        ROPE: TYPE ~ Rope.ROPE;

        Failed: ERROR ~ CODE;    -- used in ScanNumber, below.

        bigZero: BigCardinals.BigCARD ~ BigCardinals.BigFromSmall[0];
        bigOne: BigCardinals.BigCARD ~ BigCardinals.BigFromSmall[1];

        MultiplyByCARD: PROC [big: BigCardinals.BigCARD, small: CARD] RETURNS [BigCardinals.BigCARD] ~ {
            IF small = 0 OR BigCardinals.BigZero[big] THEN
                RETURN [bigZero];
            IF small <= CARD16.LAST THEN
                RETURN [BigCardinals.MultiplyByDigit[big, small]];
            RETURN [BigCardinals.BigMultiply[big, BigCardinals.BigFromCard[small]]];
            };

        Digits: TYPE ~ RECORD [small: CARD, bigScale: CARD, big: BigCardinals.BigCARD Ź BigCardinals.Zero]; -- represents 
        small+(bigScale*big)
        digitsZero: Digits ~ [small: 0, bigScale: 0, big: bigZero];
        digitsOne: Digits ~ [small: 1, bigScale: 0, big: bigZero];
        smallLimit: CARD ~ CARD.LAST/16; -- if bigger than this, can't fit another digit
<<The Scanner>>
    GetToken: PUBLIC PROC [stream: IO.STREAM, buffer: REF TEXT, flushComments: BOOL Ź TRUE, buildValue: BOOL Ź FALSE] RETURNS 
    [tokenKind: TokenKind, token: REF TEXT, error: ScanningError Ź none, value: Any Ź unspecified] ~ {
        char: CHAR Ź ' ;
        NextChar: PROC RETURNS [CHAR] ~ {
            token Ź RefText.AppendChar[token, (char Ź IO.GetChar[stream])];
            char Ź Ascii.Lower[char];
            RETURN [char];
            };
        NextStringChar: PROC RETURNS [CHAR] ~ {
            <<Like NextChar, but don't lower-case the character.>>
            token Ź RefText.AppendChar[token, (char Ź IO.GetChar[stream])];
            RETURN [char];
            };
        NextCharSkip: PROC RETURNS [CHAR] ~ {
            <<No accumulation or lower casing necessary here>>
            char Ź IO.GetChar[stream];
            RETURN [char];
            };
        PutbackChar: PROC ~ {
            IO.Backup[stream, token[token.length Ź token.length - 1]];
            };
        BadIdentifier: PROC ~ {
            <<First finish reading the token.>>
            DO
                SELECT NextChar[ ! IO.EndOfStream => EXIT] FROM
                    Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => {
                        PutbackChar[];
                        EXIT;
                        };
                    ENDCASE => NULL;
                ENDLOOP;
            tokenKind Ź error;
            value Ź StringFromRope[Rope.FromRefText[token]];
            token Ź "Illegally-formed identifier";
            error Ź badIdentifier;
            };
        BadEOF: PROC ~ {
            tokenKind Ź error;
            value Ź StringFromRope[Rope.FromRefText[token]];
            token Ź "Unexpected end of file before end of token";
            error Ź earlyEOF;
            };
        ScanNumber: PROC ~ {
            <<Some of the number has been read already; those characters are in token.  Read the rest of it into token and then analyze it.>>
            terminatedByEOF: BOOL Ź FALSE;
            DO
                SELECT NextStringChar[ ! IO.EndOfStream => { terminatedByEOF Ź TRUE; EXIT}] FROM
                    Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => {
                        PutbackChar[];
                        EXIT;
                        };
                    ENDCASE => NULL;
                ENDLOOP;

            BEGIN
                index: NAT Ź 0;
                len: NAT ~ token.length;
                char: CHAR Ź ' ;
                radix: CARDINAL Ź 0;    -- unknown
                Exactness: TYPE ~ {true, false, unknown};
                exact: Exactness Ź unknown;
                Next: PROC RETURNS [CHAR] ~ {
                    IF index >= len THEN
                        ERROR IO.EndOfStream[NIL];
                    char Ź Ascii.Lower[token[index]];
                    index Ź index + 1;
                    RETURN [char];
                    };
                Peek: PROC RETURNS [CHAR] ~ {
                    IF index >= len THEN
                        ERROR IO.EndOfStream[NIL];
                    RETURN [char Ź Ascii.Lower[token[index]]];
                    };
                Bump: PROC ~ INLINE {
                    index Ź index + 1;
                    };
                Fail: PROC [msg: REF TEXT] ~ {
                    tokenKind Ź error;
                    error Ź badNumber;
                    value Ź StringFromRope[Rope.FromRefText[token]];
                    token Ź msg;
                    ERROR Failed;
                    };
                Exact: PROC [value: Exactness] ~ {
                    IF exact = unknown THEN 
                        exact Ź value
                    ELSE
                        Fail["Too many exactness specifiers"];
                    };
                Radix: PROC [value: CARDINAL] ~ {
                    IF radix = 0 THEN 
                        radix Ź value
                    ELSE
                        Fail["Too many radix specifiers"];
                    };
                UReal: PROC [negative: BOOL] RETURNS [uReal: Any Ź NIL] ~ {
                    <<Scan an unsigned real, returning the built value if appropriate.>>
                    Which: TYPE ~ {num, denom};
                    val: ARRAY Which OF Digits Ź [num: digitsZero, denom: digitsOne];
                    exponent: INT Ź 0;
                    exponentSign: INT Ź 1;
                    Fold: PROC [w: Which] ~ {
                        val[w].big Ź BigCardinals.BigAdd[
                            MultiplyByCARD[val[w].big, val[w].bigScale],
                            BigCardinals.BigFromCard[val[w].small]
                            ];
                        val[w].small Ź 0;
                        val[w].bigScale Ź 1;
                        };
                    GetVal: PROC [w: Which] RETURNS [BigCardinals.BigCARD] ~ INLINE {
                        Fold[w];
                        RETURN [val[w].big]
                        };
                    AccumDigit: PROC [w: Which, digit: CARDINAL] ~ INLINE { -- uses radix
                        IF buildValue THEN {
                            IF val[w].small > smallLimit OR val[w].bigScale > smallLimit THEN
                                Fold[w];
                            val[w].small Ź val[w].small*radix+digit;
                            IF val[w].bigScale # 0 THEN
                                val[w].bigScale Ź val[w].bigScale*radix;
                            };
                        };
                    AccumCheckedDigit: PROC [w: Which, digit: CARDINAL] ~ {
                        IF digit >= radix THEN 
                            Fail[Rope.ToRefText[IO.PutFR["Illegal digit `%g' in radix %g numbers", [character[char]], [integer[radix]]]]]
                        ELSE
                            AccumDigit[w, digit]
                        };
                    AccumAfterDotDigit: PROC [digit: CARDINAL] ~ {
                        AccumDigit[num, digit];
                        AccumDigit[denom, 0];
                        };
                    EnsureDecimal: PROC ~ {
                        EnsureInexact[];
                        IF radix # 10 THEN 
                            Fail[Rope.ToRefText[IO.PutFR1["The character `%g' may not appear in a decimal number", [character[char]]]]];
                        };
                    EnsureInexact: PROC ~ {
                        IF exact = true THEN 
                            Fail[Rope.ToRefText[IO.PutFR1["The character `%g' may not appear in an exact number", [character[char]]]]]
                        ELSE
                            exact Ź false;
                        };
                    State: TYPE ~ {start, inNum, inNumHashes, initialDot, inDecimal, inDecimalHashes, afterExpMarker, afterExpSign, inExp, afterSlash, 
                    inDenom, inDenomHashes};
                        <<These states have the semantics portrayed in the following diagram.>>
                    state: State Ź start;
                << [Artwork node; type 'Artwork on' to command tool] >>

                    BEGIN -- for exits
                        ENABLE
                            IO.EndOfStream => 
                                SELECT state FROM
                                    start, initialDot, afterSlash, afterExpMarker =>
                                        GO TO BadEOFReturn;
                                    ENDCASE =>
                                        GO TO OKReturn;


                        SELECT Next[] FROM
                            IN ['0..'9] => {
                                AccumCheckedDigit[num, char - '0];
                                state Ź inNum;
                                };
                            IN ['a..'f] => {
                                AccumCheckedDigit[num, char - 'a + 10];
                                state Ź inNum;
                                };
                            '. => {
                                EnsureDecimal[];
                                state Ź initialDot;
                                };
                            ENDCASE => 
                                GO TO BadCharReturn;

                        DO -- finite state machine main loop
                            SELECT state FROM
                                inNum => 
                                    SELECT Peek[] FROM
                                        IN ['0..'9] => {
                                            Bump[];
                                            AccumCheckedDigit[num, char - '0];
                                            };
                                        IN ['a..'c] => {
                                            Bump[];
                                            AccumCheckedDigit[num, char - 'a + 10];
                                            };
                                        'd, 'e, 'f => {
                                            Bump[];
                                            IF radix = 16 THEN
                                                AccumDigit[num, char - 'a + 10]
                                            ELSE
                                                state Ź afterExpMarker;
                                            };
                                        's, 'l => {
                                            Bump[];
                                            state Ź afterExpMarker;
                                            };
                                        '. => {
                                            Bump[];
                                            EnsureDecimal[];
                                            state Ź inDecimal;
                                            };
                                        '/ => {
                                            Bump[];
                                            state Ź afterSlash;
                                            };
                                        '# => {
                                            Bump[];
                                            EnsureInexact[];
                                            AccumDigit[num, 0];
                                            state Ź inNumHashes;
                                            };
                                        ENDCASE =>
                                            GO TO OKReturn;
                                inNumHashes => 
                                    SELECT Peek[] FROM
                                        '# => {
                                            Bump[];
                                            AccumDigit[num, 0];
                                            };
                                        '/ => {
                                            Bump[];
                                            state Ź afterSlash;
                                            };
                                        '. => {
                                            Bump[];
                                            EnsureDecimal[];
                                            state Ź inDecimalHashes;
                                            };
                                        'e, 's, 'f, 'd, 'l => {
                                            Bump[];
                                            state Ź afterExpMarker;
                                            };
                                        ENDCASE => 
                                            GO TO OKReturn;
                                initialDot => 
                                    IF Next[] IN ['0..'9] THEN {
                                        AccumAfterDotDigit[char - '0];
                                        state Ź inDecimal;
                                        }
                                    ELSE
                                        GO TO BadCharReturn;
                                inDecimal => 
                                    SELECT Peek[] FROM
                                        IN ['0..'9] => {
                                            Bump[];
                                            AccumAfterDotDigit[char - '0];
                                            };
                                        'e, 's, 'f, 'd, 'l => {
                                            Bump[];
                                            state Ź afterExpMarker;
                                            };
                                        '# => {
                                            Bump[];
                                            AccumAfterDotDigit[0];
                                            state Ź inDecimalHashes;
                                            };
                                        ENDCASE =>
                                            GO TO OKReturn;
                                inDecimalHashes =>
                                    SELECT Peek[] FROM
                                        '# => {
                                            Bump[];
                                            <<AccumAfterDotDigit[0]; - unnecessary>>
                                            };
                                        'e, 's, 'f, 'd, 'l => {
                                            Bump[];
                                            state Ź afterExpMarker;
                                            };
                                        ENDCASE =>
                                            GO TO OKReturn;
                                afterExpMarker => {
                                    EnsureDecimal[];
                                    SELECT Next[] FROM
                                        '+ => state Ź afterExpSign;
                                        '- => {
                                            exponentSign Ź -1;
                                            state Ź afterExpSign;
                                            };
                                        IN ['0..'9] => {
                                            exponent Ź char - '0;
                                            state Ź inExp;
                                            };
                                        ENDCASE =>
                                            GO TO BadCharReturn;
                                    };
                                afterExpSign => 
                                    IF Next[] IN ['0..'9] THEN {
                                        exponent Ź exponent * 10 + char - '0;
                                        state Ź inExp;
                                        }
                                    ELSE
                                        GO TO BadCharReturn;
                                inExp =>
                                    IF Peek[] IN ['0..'9] THEN {
                                        Bump[];
                                        exponent Ź exponent * 10 + char - '0;
                                        }
                                    ELSE
                                        GO TO OKReturn;
                                afterSlash => {
                                    val[denom] Ź digitsZero;
                                    SELECT Next[] FROM
                                        IN ['0..'9] => {
                                            AccumCheckedDigit[denom, char - '0];
                                            state Ź inDenom;
                                            };
                                        IN ['a..'f] => {
                                            AccumCheckedDigit[denom, char - 'a + 10];
                                            state Ź inDenom;
                                            };
                                        ENDCASE => 
                                            GO TO BadCharReturn;
                                    };
                                inDenom =>
                                    SELECT Peek[] FROM
                                        IN ['0..'9] => {
                                            Bump[];
                                            AccumCheckedDigit[denom, char - '0];
                                            };
                                        IN ['a..'f] => {
                                            Bump[];
                                            AccumCheckedDigit[denom, char - 'a + 10];
                                            };
                                        '# => {
                                            Bump[];
                                            EnsureInexact[];
                                            AccumDigit[denom, 0];
                                            state Ź inDenomHashes;
                                            };
                                        ENDCASE => 
                                            GO TO OKReturn;
                                inDenomHashes =>
                                    IF Peek[] = '# THEN {
                                        Bump[];
                                        AccumDigit[denom, 0];
                                        }
                                    ELSE
                                        GO TO OKReturn;
                                ENDCASE => ERROR;
                            ENDLOOP;

                        EXITS
                            BadCharReturn =>
                                Fail[Rope.ToRefText[IO.PutFR1["Unexpected character `%g' in number", [character[char]]]]];
                            BadEOFReturn => {
                                IF terminatedByEOF THEN
                                    BadEOF[]
                                ELSE {
                                    tokenKind Ź error;
                                    error Ź badNumber;
                                    value Ź StringFromRope[Rope.FromRefText[token]];
                                    token Ź "Numeric token ended prematurely";
                                    };
                                ERROR Failed;
                                };
                            OKReturn => {
                                IF buildValue THEN {
                                    IF exact # false AND exponent = 0 AND val[num].bigScale = 0 AND val[denom].bigScale = 0 AND val[denom].small = 1 AND val[num].small 
                                    <= CARD[INT.LAST] THEN {
                                        <<SPECIAL CASE - Small exact integer>>
                                        uReal Ź
                                            MakeFixnum[
                                                IF negative THEN
                                                    -INT[val[num].small]
                                                ELSE
                                                    INT[val[num].small]
                                                ];
                                        }
                                    ELSE IF exact = false AND exponent = 0 AND val[num].bigScale = 0 AND val[denom].bigScale = 0 AND val[num].small <= 1000000 AND 
                                    val[denom].small <= 1000000 THEN {
                                        <<SPECIAL CASE - Small inexact real; can generate flonum with only one roundoff>>
                                        float: REAL Ź REAL[INT[val[num].small]] / REAL[INT[val[denom].small]];
                                        IF negative THEN
                                            float Ź -float;
                                        uReal Ź NEW[NumberRep.flonum Ź [FALSE, flonum[float]]];
                                        }
                                    ELSE
                                        uReal Ź
                                            MakeReal[
                                                negative: negative,
                                                numerator: GetVal[num],
                                                denominator: GetVal[denom],
                                                exponent: exponent * exponentSign,
                                                radix: 10, -- just for the exponent now
                                                exact: exact # false];
                                    };
                                RETURN;
                                };
                    END;
                    };
                MakeInteger: PROC [i: INT] RETURNS [Any] ~ {
                    <<Like Scheme.MakeFixnum, but pay attention to the setting of exact.>>
                    IF exact # false THEN 
                        RETURN [MakeFixnum[i]]
                    ELSE
                        RETURN [NEW[NumberRep.flonum Ź [FALSE, flonum[REAL[i]]]]];
                    };

                tokenKind Ź number;
                BEGIN -- for exits
                    ENABLE {
                        Failed => GO TO Return;
                        IO.EndOfStream => GO TO BadEOFReturn;
                        };

                    <<Get the prefix.>>
                        WHILE Peek[] = '# DO
                            Bump[];
                            SELECT Next[] FROM
                                'b => Radix[2];
                                'd => Radix[8];
                                'o => Radix[10];
                                'x => Radix[16];
                                'w => Radix[16];
                                'e => Exact[true];
                                'i => Exact[false];
                                ENDCASE => Fail["Illegal #-specifier in number"];
                            ENDLOOP;
                        IF radix = 0 THEN radix Ź 10;

                    <<Get the first possibly-signed real and check for the `+i', `-i', `+Ui', and `-Ui' cases.>>
                        SELECT Peek[] FROM
                            '+, '- => {
                                negative: BOOL ~ (char = '-);

                                Bump[];
                                IF Peek[] = 'i THEN {
                                    Bump[];
                                    IF buildValue THEN 
                                        value Ź MakeRectangular[MakeInteger[0], MakeInteger[IF negative THEN -1 ELSE 1]];
                                    GO TO EndCheck;
                                    };
                                value Ź UReal[negative];
                                IF Peek[! IO.EndOfStream => GO TO Return] = 'i THEN {
                                    Bump[];
                                    IF buildValue THEN 
                                        value Ź MakeRectangular[MakeInteger[0], value];
                                    GO TO EndCheck;
                                    };
                                };
                            ENDCASE => 
                                value Ź UReal[FALSE];

                    <<Check for other complex number cases.>>
                        SELECT Peek[! IO.EndOfStream => GO TO Return] FROM
                            '@ => {
                                magnitude: Any Ź value;

                                Bump[];
                                SELECT Peek[] FROM
                                    '+, '- => {
                                        Bump[];
                                        value Ź UReal[char = '-];
                                        };
                                    ENDCASE => 
                                        value Ź UReal[FALSE];
                                IF buildValue THEN 
                                    value Ź MakePolar[magnitude, value];
                                GO TO EndCheck;
                                };
                            '+, '- => {
                                negative: BOOL ~ (char = '-);
                                realPart: Any Ź value;

                                Bump[];
                                IF Peek[] = 'i THEN { -- this is the `R+i' or `R-i' case
                                    Bump[];
                                    IF buildValue THEN 
                                        value Ź MakeRectangular[value, MakeInteger[IF negative THEN -1 ELSE 1]];
                                    GO TO EndCheck;
                                    };
                                value Ź UReal[negative];
                                IF Next[] # 'i THEN 
                                    Fail["Complex number does not end in `i'"];
                                IF buildValue THEN 
                                    value Ź MakeRectangular[realPart, value];
                                GO TO EndCheck;
                                };
                            ENDCASE => GO TO EndCheck;

                    <<ERROR; -- we should never get this far; every case should be taking one of the exits>>

                    EXITS
                        Return =>
                            RETURN;
                        EndCheck => {
                            IF index # len THEN {
                                tokenKind Ź error;
                                error Ź badNumber;
                                value Ź StringFromRope[Rope.FromRefText[token]];
                                token Ź "Numeric token contains extra characters";
                                };
                            RETURN;
                            };
                        BadEOFReturn => {
                            IF terminatedByEOF THEN
                                BadEOF[]
                            ELSE {
                                tokenKind Ź error;
                                error Ź badNumber;
                                value Ź StringFromRope[Rope.FromRefText[token]];
                                token Ź "Numeric token ended prematurely";
                                };
                            RETURN;
                            };
                END;
            END;
            };
        ScanIdentifier: PROC [allowTail: BOOL] ~ {
            SELECT NextChar[ ! IO.EndOfStream => GO TO BadEOFReturn] FROM
                '# => {
                    IF NextChar[ ! IO.EndOfStream => GO TO BadEOFReturn] # '" THEN {
                        PutbackChar[];
                        BadIdentifier[];
                        RETURN;
                        }
                    ELSE {
                        ScanString[identifier];
                        RETURN;
                        };
                    };
                '+, '-, '., IN ['0..'9] => {
                    <<Identifiers can't start with these, except for the `peculiar' ones "+", "-", and "...", which are handled elsewhere.>>
                    BadIdentifier[];
                    RETURN;
                    };
                ENDCASE => {
                    IF NOT identifierConstituent[char] THEN {
                        PutbackChar[];
                        BadIdentifier[];
                        RETURN;
                        }
                    ELSE {
                        buffer: REF TEXT Ź IF buildValue THEN RefText.ObtainScratch[100] ELSE NIL;
                        AddChar: PROC ~ {
                            IF buildValue THEN
                                buffer Ź RefText.AppendChar[buffer, char];
                            };

                        AddChar[];
                        DO
                            SELECT NextChar[ ! IO.EndOfStream => EXIT] FROM
                                Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => {
                                    PutbackChar[];
                                    EXIT;
                                    };
                                '# => {
                                    IF allowTail THEN {
                                        PutbackChar[];
                                        EXIT;
                                        }
                                    ELSE {
                                        BadIdentifier[];
                                        RETURN;
                                        }
                                    };
                                ENDCASE =>
                                    IF identifierConstituent[char] THEN 
                                        AddChar[]
                                    ELSE {
                                        BadIdentifier[];
                                        RETURN;
                                        };
                            ENDLOOP;
                        tokenKind Ź identifier;
                        IF buildValue THEN {
                            value Ź Atom.MakeAtomFromRefText[buffer];
                            RefText.ReleaseScratch[buffer];
                            };
                        };
                    };

            EXITS
                BadEOFReturn => {
                    BadEOF[];
                    RETURN;
                    };
            };
        ScanIdentifierTail: PROC ~ {
            <<tokenKind is identifier, and, if buildValue, value is the appropriate symbol.  Check for this symbol being the first part of a 
            structured name.>>
            IF IO.PeekChar[stream ! IO.EndOfStream => GO TO Return] = '# THEN {
                interfaceName: Any ~ value;
                [] Ź NextChar[];    -- skip the hash mark
                ScanIdentifier[FALSE];
                IF tokenKind = identifier THEN { -- as opposed to `error'
                    tokenKind Ź moduleReference;
                    IF buildValue THEN 
                        value Ź Cons[$access, Cons[interfaceName, Cons[value, NIL]]];
                    };
                };

            EXITS
                Return => RETURN;
            };
        ScanString: PROC [nonErrorKind: TokenKind] ~ {
            buffer: REF TEXT Ź IF buildValue THEN RefText.ObtainScratch[100] ELSE NIL;
            AddChar: PROC [c: CHAR] ~ {
                IF buildValue THEN
                    buffer Ź RefText.AppendChar[buffer, c];
                };

            tokenKind Ź nonErrorKind;
            DO
                SELECT NextStringChar[ ! IO.EndOfStream => EXIT] FROM
                    '" => {
                        IF buildValue THEN {
                            SELECT nonErrorKind FROM
                                string => value Ź StringFromRope[Rope.FromRefText[buffer]];
                                identifier => value Ź Atom.MakeAtomFromRefText[buffer];
                                ENDCASE => ERROR;
                            RefText.ReleaseScratch[buffer];
                            };
                        RETURN;
                        };
                    '\\ => {
                        SELECT NextChar[ ! IO.EndOfStream => EXIT] FROM
                            'b => AddChar['\b];
                            'f, 'p => AddChar['\f];
                            'l => AddChar['\l];
                            'n => AddChar['\n];
                            'r => AddChar['\r];
                            't => AddChar['\t];
                            '", '\\ => AddChar[char];
                            IN ['0..'3] => {
                                ascii: [0 .. 377B] Ź ORD[char] - ORD['0];
                                FOR i: INT IN [3..4] DO
                                    SELECT NextChar[ ! IO.EndOfStream => EXIT] FROM
                                        IN ['0..'7] => ascii Ź ascii * 10B + ORD[char] - ORD['0];
                                        ENDCASE => {
                                            tokenKind Ź error;
                                            error Ź unknownStringEscape;
                                            value Ź StringFromRope[Rope.FromRefText[s: token, start: token.length - i, len: i]];
                                            token Ź "Unknown escape sequence in string";
                                            RETURN;
                                            };
                                    ENDLOOP;
                                AddChar[VAL[ascii]];
                                };
                            ENDCASE => {
                                tokenKind Ź error;
                                error Ź unknownStringEscape;
                                value Ź StringFromRope[Rope.FromRefText[s: token, start: token.length - 2, len: 2]];
                                token Ź "Unknown escape sequence in string";
                                RETURN;
                                };
                        };
                    ENDCASE => AddChar[char];
                ENDLOOP;

            <<We can only get here on EOF.>>
            BadEOF[];
            RETURN;
            };

        token Ź buffer;
        BEGIN    -- for exits
            DO    -- until we get a real token
                token.length Ź 0;
                SELECT NextChar[ ! IO.EndOfStream => GO TO EOFReturn] FROM
                    Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF => LOOP;
                    '; => {
                        tokenKind Ź comment;
                        IF flushComments THEN {
                            DO
                                SELECT NextCharSkip[ ! IO.EndOfStream => GO TO EOFReturn] FROM
                                    Ascii.CR, Ascii.LF => EXIT;
                                    ENDCASE;
                                ENDLOOP;
                            }
                        ELSE
                            DO
                                SELECT NextChar[ ! IO.EndOfStream => GO TO Return] FROM
                                    Ascii.CR, Ascii.LF => GO TO PutbackReturn;
                                        <<Don't include the CR in the comment>>
                                    ENDCASE;
                                ENDLOOP;
                        };
                    '( => {
                        tokenKind Ź openParenthesis;
                        RETURN};
                    ') => {
                        tokenKind Ź closeParenthesis;
                        RETURN};
                    '' => {
                        tokenKind Ź quote;
                        RETURN};
                    '` => {
                        tokenKind Ź quasiquote;
                        RETURN};
                    ', => {
                        tokenKind Ź unquote;
                        IF NextChar[ ! IO.EndOfStream => GO TO Return] = '@ THEN {
                            tokenKind Ź unquoteSplicing;
                            RETURN;
                            }
                        ELSE
                            GO TO PutbackReturn;
                        };
                    IN ['0 .. '9] => {
                        ScanNumber[];
                        RETURN};
                    '. => {    -- either dot or the peculiar identifier "..." or a number.
                        tokenKind Ź dot;
                        SELECT NextChar[ ! IO.EndOfStream => GO TO Return] FROM
                            Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => 
                                GO TO PutbackReturn;
                            IN ['0 .. '9] => {
                                ScanNumber[];
                                RETURN};
                            '. => {
                                SELECT NextChar[ ! IO.EndOfStream => GO TO BadEOFReturn] FROM
                                    Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", ' => {
                                        PutbackChar[];
                                        BadIdentifier[];
                                        RETURN};
                                    '. => NULL;
                                    ENDCASE => {
                                        BadIdentifier[];
                                        RETURN};
                                tokenKind Ź identifier;
                                IF buildValue THEN
                                    value Ź Atom.MakeAtom["..."];
                                <<Check that the token is properly delimited.>>
                                SELECT IO.PeekChar[stream ! IO.EndOfStream => GO TO Return] FROM
                                    Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => 
                                        RETURN;
                                    '# => {
                                        ScanIdentifierTail[];
                                        RETURN};
                                    ENDCASE => {
                                        BadIdentifier[];
                                        RETURN};
                                };
                            ENDCASE => {
                                BadIdentifier[];
                                RETURN};
                        };
                    '+, '- => {    -- either a peculiar identifier ("+" or "-") or a number.
                        tokenKind Ź identifier;
                        IF buildValue THEN
                            value Ź Atom.MakeAtomFromChar[char];
                        SELECT IO.PeekChar[stream ! IO.EndOfStream => GO TO Return] FROM
                            Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; =>
                                RETURN;
                            '# => {
                                ScanIdentifierTail[];
                                RETURN};
                            ENDCASE => {
                                ScanNumber[];
                                RETURN};
                        };
                    '#=> {
                        SELECT NextChar[ ! IO.EndOfStream => GO TO BadEOFReturn] FROM
                            't, 'f => {
                                tokenKind Ź boolean;
                                IF buildValue THEN 
                                    value Ź IF char = 't THEN true ELSE false;
                                RETURN};
                            'b, 'o, 'd, 'x, 'w, 'i, 'e => {
                                ScanNumber[];
                                RETURN};
                            '\\ => {
                                found: BOOL;
                                buffer: REF TEXT Ź RefText.ObtainScratch[10];
                                DO
                                    SELECT NextStringChar[ ! IO.EndOfStream => IF buffer.length = 0 THEN GO TO BadEOFReturn ELSE EXIT] FROM
                                        Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => {
                                            IF buffer.length = 0 THEN
                                                buffer Ź RefText.AppendChar[buffer, char]
                                            ELSE
                                                PutbackChar[];
                                            EXIT;
                                            };
                                        ENDCASE => buffer Ź RefText.AppendChar[buffer, char];
                                    ENDLOOP;

                                tokenKind Ź character;
                                <<We must treat one-character names specially because the SymTab below is case-insensitive.>>
                                IF buffer.length = 1 THEN {
                                    IF buildValue THEN 
                                        value Ź MakeChar[buffer[0]];
                                    RETURN;
                                    };
                                [found, value] Ź SymTab.Fetch[x: charForName, key: RefText.TrustTextAsRope[buffer]];
                                RefText.ReleaseScratch[buffer];
                                IF NOT found THEN {
                                    tokenKind Ź error;
                                    error Ź unknownCharacterName;
                                    value Ź StringFromRope[Rope.FromRefText[token]];
                                    token Ź "Unknown named character"
                                    };
                                RETURN};
                            '( => {
                                tokenKind Ź openVector;
                                RETURN};
                            '" => {
                                ScanString[identifier];
                                IF tokenKind = identifier THEN -- as opposed to `error'
                                    ScanIdentifierTail[];
                                RETURN};
                            '! => {
                                found: BOOL;
                                buffer: REF TEXT Ź RefText.ObtainScratch[10];
                                DO
                                    SELECT NextStringChar[ ! IO.EndOfStream => IF buffer.length = 0 THEN GO TO BadEOFReturn ELSE EXIT] FROM
                                        Ascii.SP, Ascii.TAB, Ascii.CR, Ascii.LF, Ascii.FF, '(, '), '", '; => {
                                            IF buffer.length = 0 THEN
                                                buffer Ź RefText.AppendChar[buffer, char]
                                            ELSE
                                                PutbackChar[];
                                            EXIT;
                                            };
                                        ENDCASE => buffer Ź RefText.AppendChar[buffer, char];
                                    ENDLOOP;

                                tokenKind Ź character;
                                [found, value] Ź SymTab.Fetch[x: primitiveSyntaxForName, key: RefText.TrustTextAsRope[buffer]];
                                RefText.ReleaseScratch[buffer];
                                IF NOT found THEN {
                                    tokenKind Ź error;
                                    error Ź unknownPrimitiveSyntax;
                                    value Ź StringFromRope[Rope.FromRefText[token]];
                                    token Ź "Unknown primitive syntax marker"
                                    };
                                RETURN};
                            ENDCASE => {
                                tokenKind Ź error;
                                error Ź unknownHashDispatch;
                                value Ź StringFromRope[Rope.FromRefText[token]];
                                token Ź "Unknown # token";
                                RETURN};
                        };
                    '"=> {
                        ScanString[string];
                        RETURN};
                    ENDCASE => {
                        PutbackChar[];
                        ScanIdentifier[TRUE];
                        IF tokenKind = identifier THEN
                            ScanIdentifierTail[];
                        RETURN};
                ENDLOOP; 
            EXITS
                Return => { RETURN };
                PutbackReturn => {
                    PutbackChar[];
                    RETURN};
                BadEOFReturn => {
                    BadEOF[];
                    RETURN};
                EOFReturn => {
                    tokenKind Ź endOfFile;
                    RETURN};
        END;
        }; 

    primitiveSyntaxForName: SymTab.Ref ~ InitPrimitiveSyntax[];
    InitPrimitiveSyntax: PROC RETURNS [table: SymTab.Ref] ~ {
        table Ź SymTab.Create[case: FALSE];
        FOR ps: PrimitiveSyntaxRep IN PrimitiveSyntaxRep DO
            [] Ź SymTab.Store[x: table, key: Atom.GetPName[symbolForPrimitiveSyntaxRep[ps]], val: primitiveSyntaxForPrimitiveSyntaxRep[ps]];
            ENDLOOP;
        };

    charForName: SymTab.Ref ~ SymTab.Create[case: FALSE];
    nameForChar: REF ARRAY CHAR OF ROPE ~ InitCharNames[];
    InitCharNames: PROC RETURNS [REF ARRAY CHAR OF ROPE] ~ {
        a: REF ARRAY CHAR OF ROPE Ź NEW[ARRAY CHAR OF ROPE];
        AddName: PROC [char: CHAR, name: ROPE] ~ {
            [] Ź SymTab.Store[x: charForName, key: name, val: MakeChar[char]];
            a[char] Ź name;
            };

        <<Names are added in increasing order of preference on output.  That is, the last name assigned to each character is the one to be 
        used on output.>>

        FOR c: CHAR IN CHAR DO
            AddName[c, Rope.Flatten[IO.PutFR1["%03b", [integer[ORD[c]]]]]];
            ENDLOOP;

        AddName['(, Rope.Flatten["OpenPar"]];
        AddName['(, Rope.Flatten["OpenParen"]];
        AddName['), Rope.Flatten["ClosePar"]];
        AddName['), Rope.Flatten["CloseParen"]];

        FOR c: CHAR IN (' ..'~] DO
            AddName[c, Rope.FromChar[c]];
            ENDLOOP;

        AddName['\r, Rope.Flatten["Return"]];
        AddName['\l, Rope.Flatten["LineFeed"]];
        AddName['\n, Rope.Flatten["Newline"]];
        AddName['\t, Rope.Flatten["Tab"]];
        AddName[' , Rope.Flatten["Space"]];
        AddName['\f, Rope.Flatten["FormFeed"]];
        AddName['\f, Rope.Flatten["Page"]];

        RETURN [a]
        };

    identifierConstituent: REF ARRAY CHAR OF BOOL ~ InitIdentifierConstituent[];
    InitIdentifierConstituent: PROC RETURNS [a: REF ARRAY CHAR OF BOOL] ~ {
        a Ź NEW[ARRAY CHAR OF BOOL Ź ALL[FALSE]];
        FOR c: CHAR IN ['0..'9] DO
            a[c] Ź TRUE;
            ENDLOOP;
        FOR c: CHAR IN ['A..'Z] DO
            a[c] Ź TRUE;
            ENDLOOP;
        FOR c: CHAR IN ['a..'z] DO
            a[c] Ź TRUE;
            ENDLOOP;
        a['!] Ź TRUE;
        a['$] Ź TRUE;
        a['%] Ź TRUE;
        a['&] Ź TRUE;
        a['*] Ź TRUE;
        a['/] Ź TRUE;
        a[':] Ź TRUE;
        a['<] Ź TRUE;
        a['=] Ź TRUE;
        a['>] Ź TRUE;
        a['?] Ź TRUE;
        a['~] Ź TRUE;
        a['_] Ź TRUE;
        a['^] Ź TRUE;
        a['.] Ź TRUE;
        a['+] Ź TRUE;
        a['-] Ź TRUE;
        };
<<Testing>>
    Test: PROC [name: ROPE, out: IO.STREAM] ~ {
        in: IO.STREAM ~ FS.StreamOpen[name];
        buffer: REF TEXT Ź NEW[TEXT[10]];
        token: REF TEXT Ź NEW[TEXT[10]];
        tokenKind: TokenKind;
        error: ScanningError;
        value: Any;

        DO
            [tokenKind, token, error, value] Ź GetToken[in, buffer, FALSE, TRUE];
            SELECT tokenKind FROM
                identifier, moduleReference, boolean, number, character, string, primitiveSyntax =>
                    IO.PutF[out, "%g: %g\n", [refAny[NEW[TokenKind Ź tokenKind]]], [refAny[value]]];
                endOfFile => EXIT;
                error =>
                    IO.PutF[out, "**Error (%g)** %g\n\t%g\n", [refAny[NEW[ScanningError Ź error]]], [text[token]], [refAny[value]]];
                comment => IO.PutF1[out, "%g\n", [text[token]]];
                ENDCASE => 
                    IO.PutF[out, "%g: %g\n", [refAny[NEW[TokenKind Ź tokenKind]]], [text[token]]];
            ENDLOOP;

        IO.Close[in];
        };
    <<>>
    END.