
<<RoseTranslateRead.Mesa>>
<<Last Edited by: Spreitzer, April 28, 1985 3:28:42 pm PDT>>
<<Last Edited by: Barth, March 8, 1983 10:43 am>>
<<Last Edited by: Gasbarro, August 16, 1984 3:42:16 pm PDT>>

    DIRECTORY AMTypes, Convert, IO, OpPrecParse, OrderedSymbolTableRef, ProcessExtras, Rope, RoseTranslateTypes, RoseTranslateInsides, 
    SignalTypeRegistration, TextNode, TiogaStreams;

    RoseTranslateRead: CEDAR PROGRAM
        IMPORTS Convert, IO, OPP: OpPrecParse, OSTR: OrderedSymbolTableRef, ProcessExtras, Rope, RoseTranslateTypes, RoseTranslateInsides, 
        SignalTypeRegistration, TS: TiogaStreams
        EXPORTS RoseTranslateInsides =

    BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;

    wasRef: PUBLIC WasRef _ NEW [WasRefRep _ ["was module reference"]];

    arglikeError, oplikeError: OPP.Token;

    ops: PUBLIC SymbolTable _ OSTR.CreateTable[CompareOps];

    ltClass, gtClass, eqClass, lambdaClass, returnClass, cellClass, cellEndClass, nameClass, portsProcClass, applyClass, sfClass, 
    isfClass, initializerClass, refClass, recClass, ivClass, testClass, bbClass, stClass, expandClass, portsClass, cedarClass, 
    initCTPropsClass, errorClass, noisyErrClass, myArgClass: TokenClass;

    evalClasses: ARRAY EvalType OF TokenClass;
    auxClasses: ARRAY AuxClass OF TokenClass;

    autoName: Op _ NIL;

    MyBreak: PUBLIC IO.BreakProc =
        {RETURN [SELECT char FROM
            IN ['a..'z], IN ['A .. 'Z], IN ['0 .. '9] => other,
            IO.SP, IO.CR, IO.TAB, IO.LF, IO.FF => sepr,
            ENDCASE => break]};

    ErrCheck: PUBLIC PROC [args: OPP.ArgList] RETURNS [errFound: BOOLEAN] =
        BEGIN
        WHILE args # NIL DO
            IF args.first.arg = error THEN RETURN [TRUE];
            args _ args.rest;
            ENDLOOP;
        errFound _ FALSE;
        END;

    OpsCheck: PUBLIC PROC [context: REF ANY, sr: SourceRange, ops: OpPrecParse.TokenList, classes: TokenClassList] RETURNS [err: BOOL] =
        BEGIN
        err _ FALSE;
        WHILE (ops # NIL) AND (classes # NIL) AND NOT err DO
            IF ops.first.class # classes.first THEN {err _ TRUE; EXIT};
            ops _ ops.rest;
            classes _ classes.rest;
            ENDLOOP;
        IF (ops # NIL) # (classes # NIL) THEN err _ TRUE;
        IF (ops = NIL) AND (classes # NIL) THEN {
            Whimper[sr, context, SELECT classes.first FROM
                returnClass => "missing RETURN",
                rsClass => "missing right square-bracket",
                cellEndClass => "missing EndCellType",
                ENDCASE => "mismatched LAMBDA - RETURN, [ - ], or CellType - EndCellType"];
            RETURN};
        IF err THEN Whimper[sr, context, "mismatched LAMBDA - RETURN, [ - ], or CellType - EndCellType"];
        END;

    ReduceNoisily: PUBLIC OPP.Reducer =
        BEGIN
        reduced _ Complain[sr, context, "Missing op before %g", IO.refAny[args.rest.first.arg]];
        END;

    SimplerReduce: PUBLIC OPP.Reducer = {reduced _ args.first.arg};

    ReduceError: PUBLIC OPP.Reducer = {reduced _ error};

    ReduceIntElt: PUBLIC OPP.Reducer =
        BEGIN
        ie: InterfaceElt _ NEW [InterfaceEltRep _ []];
        nodeType: REF ANY;
        IF ErrCheck[args] THEN RETURN [error];
        SELECT ops.first.class FROM
            ltClass => ie.input _ NOT (ie.output _ FALSE);
            gtClass => ie.input _ NOT (ie.output _ TRUE);
            eqClass => ie.input _ ie.output _ TRUE;
            ENDCASE => ERROR;
        WITH args.first.arg SELECT FROM
            id: ID => ie.name _ id.rope;
            ENDCASE => RETURN [Complain[sr, context, "An Interface Element must be identified by an ID, not %g", IO.refAny[args.first.arg]]];
        IF (nodeType _ args.rest.first.arg) = omitted THEN {
            IF SignalTypeRegistration.defaultNodeType = NIL THEN RETURN [Complain[sr, context, "No default NodeType"]];
            nodeType _ NEW [IDRep _ [sr, SignalTypeRegistration.defaultNodeType]]};
        WITH nodeType SELECT FROM
            sti: SignalTypeInvocation => ie.sti _ sti;
            id: ID => IF (ie.sti _ InstantiateSignalType[context, id.rope, NIL]) = NIL THEN RETURN [error];
            ENDCASE => RETURN [Complain[sr, context, "An Interface Element must use a Signal Type, not %g", IO.refAny[nodeType]]];
        ie.sr _ sr;
        reduced _ ie;
        END;

    ReduceLambda: PUBLIC OPP.Reducer =
        BEGIN
        cf: CellFn _ NEW [CellFnRep _ []];
        ok: BOOL _ TRUE;
        IF ErrCheck[args] THEN RETURN [error];
        IF OpsCheck[context, sr, ops, LIST[lambdaClass, returnClass]] THEN RETURN [error];
        WITH args.first.arg SELECT FROM
            sb: SquareBracketed => WITH sb.subject SELECT FROM
                bl: BindingList => cf.args _ bl;
                ENDCASE => ok _ FALSE;
            ENDCASE => ok _ FALSE;
        IF NOT ok THEN RETURN [Complain[sr, context, "LAMBDA must be given parameters, not %g", IO.refAny[args.first.arg]]];
        WITH args.rest.first.arg SELECT FROM
            cd: CellDef => cf.cd _ cd;
            ENDCASE => ok _ FALSE;
        IF NOT ok THEN RETURN [Complain[sr, context, "I can only construct functions that return cell types, not %g", 
        IO.refAny[args.rest.first.arg]]];
        cf.cd.forFn _ cf;
        cf.sr _ sr;
        reduced _ cf;
        END;

    CedarExpressionRope: PUBLIC PROC [fc: CedarExpression] RETURNS [r: ROPE] =
        {r _ fc.rope};

    CedarFromRope: PUBLIC PROC [r: ROPE, sr: SourceRange _ nullSR] RETURNS [fc: CedarExpression] = {
        fc _ NEW [CedarExpressionRep _ [sr, internal, r]];
        };

    CedarFromID: PUBLIC PROC [id: ID] RETURNS [fc: CedarExpression] =
        {fc _ NEW [CedarExpressionRep _ [sr: id.sr, kind: id, rope: id.rope]]};

    CedarFromQuoted: PUBLIC PROC [q: Quoted] RETURNS [fc: CedarExpression] =
        {fc _ NEW [CedarExpressionRep _ [sr: q.sr, kind: ropeLiteral, rope: Convert.RopeFromRope[q.rope]]]};

    Sofar: PUBLIC PROC [sr: SourceRange, context, org: REF ANY] RETURNS [cd: CellDef] =
        BEGIN
        IF org = autoName THEN cd _ NEW [CellDefRep _ [sr: sr, nameIsLiteral: FALSE, nameSource: NIL]]
        ELSE WITH org SELECT FROM
            q: Quoted => {
                cd _ NEW [CellDefRep _ [sr: sr, literalName: q.rope, nameIsLiteral: TRUE]];
                };
            cellDef: CellDef => {cd _ cellDef; cd.sr _ sr};
            ENDCASE => {
                [] _ Complain[sr, context, "Bad Cell header: %g", IO.refAny[org]];
                cd _ NIL;
                };
        END;

    InsistOnCedarChildren: PUBLIC PROC [context: REF ANY, sofar: REF ANY, args: OPP.ArgList] RETURNS [cs: CedarChildren, reduced: REF 
    ANY] =
        BEGIN
        WITH args.rest.first.arg SELECT FROM
            cedar: CedarChildren => {cs _ cedar; reduced _ sofar};
            ENDCASE => {cs _ NIL; reduced _ Complain[nullSR, context, "Internal Error"]};
        END;

    AuxKnown: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [known: BOOL] =
        {known _ GetAux[name, cellDef, auxClass, auxVal] # NIL};

    AuxSpecd: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [given: BOOL] = {
        SELECT auxClass FROM
            State => IF cellDef.sfSource # NIL THEN RETURN [TRUE];
            SwitchIO, SimpleIO, Drive => IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.asList # NIL THEN RETURN [TRUE];
            ENDCASE => ERROR;
        given _ cellDef.auxes[auxClass][auxVal] # NIL;
        };

    GetAux: PUBLIC PROC [name: ROPE, cellDef: CellDef, auxClass: AuxClass, auxVal: AuxVal] RETURNS [aux: ROPE] = {
        SELECT auxClass FROM
            State => IF cellDef.sfSource # NIL THEN RETURN [SELECT auxVal FROM
                Ref => IO.PutFR["%gStateRef", IO.rope[name]],
                Rec => IO.PutFR["%gStateRec", IO.rope[name]],
                Val => IO.PutFR["NEW[%gStateRec%g]", IO.rope[name], IO.rope[IF cellDef.stateInittable THEN " _ []" ELSE ""]],
                ENDCASE => ERROR];
            SwitchIO, SimpleIO, Drive => IF cellDef.interfaceLiteral # NIL AND cellDef.interfaceLiteral.asList # NIL THEN RETURN [SELECT auxVal 
            FROM
                Ref => IO.PutFR["%g%gRef", IO.rope[name], IO.rope[auxClassNames[auxClass]]],
                Rec => IO.PutFR["%g%gRec", IO.rope[name], IO.rope[auxClassNames[auxClass]]],
                Val => IO.PutFR["NEW[%g%gRec]", IO.rope[name], IO.rope[auxClassNames[auxClass]]],
                ENDCASE => ERROR];
            ENDCASE => ERROR;
        RETURN [SELECT auxVal FROM
            Val =>
                IF cellDef.auxes[auxClass][Val] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Val]]
                ELSE IF cellDef.auxes[auxClass][Rec] # NIL THEN Rope.Cat["NEW[", CedarExpressionRope[cellDef.auxes[auxClass][Rec]], "]"]
                ELSE NIL,
            Rec => IF cellDef.auxes[auxClass][Rec] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Rec]] ELSE NIL,
            Ref =>
                IF cellDef.auxes[auxClass][Ref] # NIL THEN CedarExpressionRope[cellDef.auxes[auxClass][Ref]]
                ELSE IF cellDef.auxes[auxClass][Rec] # NIL THEN Rope.Cat["REF ", CedarExpressionRope[cellDef.auxes[auxClass][Rec]] ]
                ELSE NIL,
            ENDCASE => ERROR];
        };

    ReduceName: PUBLIC OPP.Reducer =
        BEGIN
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first.arg SELECT FROM
            cs: CedarChildren => reduced _ NEW [CellDefRep _ [sr: sr, nameIsLiteral: FALSE, nameSource: cs ]];
            ENDCASE => RETURN [Complain[sr, context, "Internal Error"]];
        END;

    ReduceCell: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF OpsCheck[context, sr, ops, LIST[cellClass, cellEndClass]] THEN RETURN [error];
        IF (reduced _ sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.interfaceLiteral = NIL AND sofar.interfaceSource = NIL THEN sofar.interfaceLiteral _ DigestInterface[context, NIL];
        END;

    ReducePortsProc: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.interfaceSource # NIL THEN Whimper[sr, context, "Redefining PortsProc"];
        [sofar.interfaceSource, reduced] _ InsistOnCedarChildren[context, sofar, args];
        END;

    ReduceApply: PUBLIC OPP.Reducer =
        BEGIN
        cf: CellFn;
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first.arg SELECT FROM
            cellFn: CellFn => cf _ cellFn;
            ENDCASE => RETURN [Complain[sr, context, "HowToApply tacked onto %g, should have been a Cell Type Function", 
            IO.refAny[args.first.arg]]];
        IF cf.howToApply # NIL THEN Whimper[sr, context, "Redefining how to Apply"];
        cf.sr _ sr;
        [cf.howToApply, reduced] _ InsistOnCedarChildren[context, cf, args];
        END;

    ReduceStateFields: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF AuxSpecd[NIL, sofar, State, Rec] THEN Whimper[sr, context, "Redefining State Record Type"];
        [sofar.sfSource, reduced] _ InsistOnCedarChildren[context, sofar, args];
        sofar.stateInittable _ FALSE;
        END;

    ReduceInitStateFields: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF AuxSpecd[NIL, sofar, State, Rec] THEN Whimper[sr, context, "Redefining State Record Type"];
        [sofar.sfSource, reduced] _ InsistOnCedarChildren[context, sofar, args];
        sofar.stateInittable _ TRUE;
        END;

    ReducePorts: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        WITH args.rest.first.arg SELECT FROM
            sb: SquareBracketed => {
                IF NOT ISTYPE[sb.subject, InterfaceEltList] THEN RETURN [Complain[sr, context, "PORTS must be given a square bracketed interface 
                element list, not %g", IO.refAny[args.rest.first.arg]]];
                sofar.interfaceLiteral _ DigestInterface[context, NARROW[sb.subject]]
                }
            ENDCASE => reduced _ Complain[sr, context, "PORTS must be given a square bracketed interface element list, not %g", 
            IO.refAny[args.rest.first.arg]];
        reduced _ sofar;
        END;

    ReduceExpand: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.expandCode # NIL THEN Whimper[sr, context, "Redefining Expand Proc"];
        reduced _ sofar;
        WITH args.rest.first.arg SELECT FROM
            s: Statements => sofar.expandCode _ s;
            cs: CedarChildren => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[cs]]];
            bl: BindingList => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[bl]]];
            b: Binding => sofar.expandCode _ NEW [StatementsRep _ [sr, LIST[b]]];
            ENDCASE => reduced _ Complain[sr, context, "EXPAND must be given a statement or statement list, not %g", 
            IO.refAny[args.rest.first.arg]];
        END;

    ReduceInitializer: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.initializerSource # NIL THEN Whimper[sr, context, "Redefining Initializer"];
        [sofar.initializerSource, reduced] _ InsistOnCedarChildren[context, sofar, args];
        END;

    ReduceEval: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        type: EvalType _ ToEvalType[ops.first.class];
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.evals[type] # NIL THEN Whimper[sr, context, "Redefining %g Proc", IO.rope[etNames[type]]];
        [sofar.evals[type], reduced] _ InsistOnCedarChildren[context, sofar, args];
        END;

    ToEvalType: PROC [class: TokenClass] RETURNS [et: EvalType] =
        BEGIN
        FOR et IN EvalType DO IF evalClasses[et] = class THEN RETURN ENDLOOP;
        ERROR;
        END;

    ReduceTest: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        reduced _ sofar;
        WITH args.rest.first.arg SELECT FROM
            tn: TestNote => sofar.tests _ CONS[tn, sofar.tests];
            ENDCASE => reduced _ Complain[sr, context, "Confusion after Test (got %g)", IO.refAny[args.rest.first.arg]];
        END;

    ReduceTestClass: PUBLIC OPP.Reducer =
        BEGIN
        tn: TestNote _ NEW [TestNoteRep _ [sr: sr, name: NIL, code: NIL, stateToo: FALSE]];
        IF ErrCheck[args] THEN RETURN [error];
        reduced _ tn;
        WITH args.first.arg SELECT FROM
            id: ID => tn.name _ id.rope;
            ENDCASE => RETURN [Complain[sr, context, "BLACKBOX or STATETOO should be proceeded with an ID, not %g", IO.refAny[args.first.arg]]];
        WITH args.rest.first.arg SELECT FROM
            cs: CedarChildren => tn.code _ cs;
            ENDCASE => RETURN [Complain[sr, context, "BLACKBOX or STATETOO should be followed by cedar children, not %g", 
            IO.refAny[args.rest.first.arg]]];
        SELECT ops.first.class FROM
            bbClass => tn.stateToo _ FALSE;
            stClass => tn.stateToo _ TRUE;
            ENDCASE => ERROR;
        END;

    ReduceAuxClass: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        auxClass: AuxClass;
        auxed: Auxed;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        FOR ac: AuxClass IN AuxClass DO
            IF ops.first.class = auxClasses[ac] THEN {auxClass _ ac; EXIT};
            REPEAT
                FINISHED => ERROR;
            ENDLOOP;
        WITH args.rest.first.arg SELECT FROM
            a: Auxed => auxed _ a;
            ENDCASE => RETURN[Complain[sr, context, "Confusion after SwitchAux or SimpleAux or StateAux or DriveAux (got %g)", 
            IO.refAny[args.rest.first.arg]]];
        IF AuxSpecd[NIL, sofar, auxClass, auxed.val] THEN Whimper[sr, context, "Redefining %g %g", IO.rope[auxClassNames[auxClass]], 
        IO.rope[auxValNames[auxed.val]]];
        sofar.auxes[auxClass][auxed.val] _ auxed.subject;
        reduced _ sofar;
        END;

    ReduceAuxVal: PUBLIC OPP.Reducer =
        BEGIN
        auxed: Auxed _ NEW [AuxedRep _ [sr: sr, val: , subject: NIL]];
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first.arg SELECT FROM
            id: ID => auxed.subject _ CedarFromID[id];
            q: Quoted => auxed.subject _ CedarFromQuoted[q];
            fc: CedarExpression => auxed.subject _ fc;
            ENDCASE => RETURN[Complain[sr, context, "REFTYPE or RECTYPE or INITIALVALUE given %g, instead of an ID or CedarLiteral", 
            IO.refAny[args.first.arg]]];
        SELECT ops.first.class FROM
            refClass => auxed.val _ Ref;
            recClass => auxed.val _ Rec;
            ivClass => auxed.val _ Val;
            ENDCASE => ERROR;
        reduced _ auxed;
        END;

    ReduceInitCTProps: PUBLIC OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[sr, context, args.first.arg]) = NIL THEN RETURN [error];
        IF sofar.initCTPropsSource # NIL THEN Whimper[args.rest.first.sr, context, "Redefining Initial Props Proc"];
        [sofar.initCTPropsSource, reduced] _ InsistOnCedarChildren[context, sofar, args];
        END;

    CompareOps: PUBLIC OSTR.CompareProc =
        BEGIN
        s1, s2: ROPE;
        s1 _ WITH r1 SELECT FROM
            r: ROPE => r,
            op: Op => op.name,
            ENDCASE => ERROR;
        s2 _ WITH r2 SELECT FROM
            r: ROPE => r,
            op: Op => op.name,
            ENDCASE => ERROR;
        RETURN [s1.Compare[s2, FALSE]];
        END;

    ParseExpression: PUBLIC PROC [job: Job] RETURNS [expr: REF ANY] =
        BEGIN

        GetToken: PROC [context: REF ANY, expectingArg: BOOLEAN] RETURNS [token: OPP.Token] --OPP.TokenProc-- =
            BEGIN
            asRope: ROPE;
            op: Op;
            peek: CHAR;
            startIdx: INT;
            GetSR: PROC RETURNS [sr: SourceRange] = {
                next: INT _ job.from.GetIndex[];
                sr _ [startIdx, next-1]};
            HandleNumber: PROC [sgn: INT] RETURNS [OPP.Token] =
                BEGIN
                tokenKind: IO.TokenKind;
                token: ROPE;
                [tokenKind, token, ] _ job.from.GetCedarTokenRope[];
                SELECT tokenKind FROM
                    tokenREAL => RETURN [[GetSR[], myArgClass, NEW [ReelRep _ [GetSR[], Convert.RealFromLiteral[token]*sgn]]]];
                    tokenDECIMAL, tokenOCTAL, tokenHEX => RETURN [[
                        GetSR[],
                        myArgClass,
                        NEW [IntRep _ [
                            GetSR[],
                            sgn*Convert.CardFromWholeNumberLiteral[token]]]]];
                    ENDCASE => ERROR;
                END;
            WHILE TRUE DO
                ProcessExtras.CheckForAbort[];
                IF useOld THEN {useOld _ FALSE; RETURN [[oldSR, myArgClass, old]]};
                [] _ job.from.SkipWhitespace[flushComments: FALSE];
                startIdx _ job.from.GetIndex[];
                IF job.from.EndOf[] THEN RETURN [OPP.end];
                job.tokenCount _ job.tokenCount + 1;
                peek _ job.from.PeekChar[];
                IF peek = '" THEN
                    BEGIN
                    asAny: REF ANY;
                    asRope: ROPE;
                    asAny _ IO.GetRefAny[job.from !IO.Error, IO.EndOfStream => {
                        Whimper[GetSR[], job, "Syntax error in quoted string"];
                        asAny _ error;
                        CONTINUE}];
                    IF asAny = error THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError];
                    asRope _ NARROW[asAny];
                    RETURN [[GetSR[], myArgClass, NEW [QuotedRep _ [GetSR[], asRope]] ]];
                    END;
                IF peek = '| THEN
                    BEGIN
                    cedar: ROPE _ NIL;
                    IF job.from.GetChar[] # '| THEN ERROR;
                    WHILE NOT job.from.EndOf[] DO
                        char: CHAR _ job.from.GetChar[];
                        IF char = '| THEN
                            BEGIN
                            IF job.from.PeekChar[] # '| THEN EXIT ELSE [] _ job.from.GetChar[];
                            END;
                        cedar _ cedar.Concat[Rope.FromChar[char]];
                        ENDLOOP;
                    RETURN [[GetSR[], myArgClass, NEW [CedarExpressionRep _ [GetSR[], cedarLiteral, cedar]] ]];
                    END;
                IF peek = '( THEN
                    BEGIN
                    asAny: REF ANY;
                    asAny _ IO.GetRefAny[job.from !IO.Error, IO.EndOfStream => {
                        Whimper[GetSR[], job, "Syntax error in list"];
                        asAny _ error;
                        CONTINUE}];
                    IF asAny = error THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError];
                    RETURN [[GetSR[], myArgClass, NEW [RefAnyListRep _ [GetSR[], NARROW[asAny]]] ]];
                    END;
                IF peek IN ['0 .. '9] THEN RETURN [HandleNumber[1]];
                IF peek = '$ THEN {
                    err: BOOL _ FALSE;
                    IF job.from.GetChar[] # '$ THEN ERROR;
                    asRope _ job.from.GetRopeLiteral[ !IO.Error, IO.EndOfStream => {
                        Whimper[GetSR[], job, "should have quoted string following dollar sign"];
                        err _ TRUE;
                        CONTINUE}];
                    IF err THEN RETURN [IF expectingArg THEN arglikeError ELSE oplikeError];
                    RETURN [[GetSR[], myArgClass, NEW [IDRep _ [GetSR[], asRope]] ]];
                    };
                IF peek = '_ THEN {
                    IF job.from.GetChar[] # '_ THEN ERROR;
                    asRope _ "_";
                    SELECT job.from.PeekChar[] FROM
                        IN ['a .. 'z], IN ['A .. 'Z] => asRope _ asRope.Cat[Rope.FromChar[job.from.GetChar[]]];
                        ENDCASE;
                    }
                ELSE IF peek = '- THEN
                    BEGIN
                    IF job.from.GetChar[] # '- THEN ERROR;
                    IF (peek _ job.from.PeekChar[]) = '- THEN
                        BEGIN
                        IF job.from.GetChar[] # '- THEN ERROR;
                        WHILE NOT job.from.EndOf[] DO
                            char: CHAR _ job.from.GetChar[];
                            IF char = '\n THEN EXIT;
                            IF char = '- THEN
                                BEGIN
                                char _ job.from.GetChar[];
                                IF char = '- OR char = '\n THEN EXIT;
                                END;
                            ENDLOOP;
                        LOOP;
                        END
                    ELSE IF peek IN ['0 .. '9] THEN RETURN [HandleNumber[-1]]
                    ELSE asRope _ "-";
                    END
                ELSE IF peek = '. THEN {
                    IF job.from.GetChar[] # '. THEN ERROR;
                    IF (peek _ job.from.PeekChar[]) = '. THEN {
                        IF job.from.GetChar[] # '. THEN ERROR;
                        asRope _ "..";
                        }
                    ELSE asRope _ ".";
                    }
                ELSE asRope _ job.from.GetTokenRope[MyBreak].token;
                op _ NARROW[ops.Lookup[asRope]];
                IF op = NIL THEN RETURN [[GetSR[], myArgClass, NEW [IDRep _ [GetSR[], asRope]] ]];
                IF op.eatsCedar THEN
                    BEGIN
                    char: CHAR _ job.from.GetChar[];    --counter Backup in GetToken
                    parent: TextNode.Ref _ TS.CurInNode[job.from];
                    <<to allow comments there, don't test: IF char # '\n THEN ERROR;>>
                    TS.SkipChildren[job.from];
                    useOld _ TRUE;
                    oldSR _ GetSR[];
                    old _ NEW [CedarChildrenRep _ [GetSR[], parent]];
                    END;
                IF op.class[expectingArg] = NIL THEN
                    BEGIN
                    job.log.PutF["Syntax error at %g: %g not allowed\n", IO.int[job.from.GetIndex[]], IO.rope[asRope]];
                    job.errCount _ job.errCount + 1;
                    RETURN [IF expectingArg THEN arglikeError ELSE oplikeError];
                    END;
                RETURN [[GetSR[], op.class[expectingArg], op]];
                ENDLOOP;
            END;

        useOld: BOOLEAN _ FALSE;
        oldSR: SourceRange;
        old: REF ANY _ NIL;

        [] _ job.from.GetIndex[];
        [[, expr]] _ OPP.Parse[job, GetToken !OPP.CantReduce, OPP.CantFix, OPP.DoesntFix, OPP.TerminateErr, OPP.LastReduceErr, 
        OPP.InvalidToken =>
            BEGIN
            job.log.PutF["Congratulations! You trashed the parser (somewhere before %g)... You lose!\n", IO.int[job.from.GetIndex[]]];
            job.errCount _ job.errCount + 1;
            expr _ NIL;
            CONTINUE;
            END];
        END;

    Setup: PROC =
        BEGIN

        noisyErrClass _ NEW[TokenClassRep    _ [2000, 3000, ReduceNoisily]];
        myArgClass    _ NEW[TokenClassRep    _ [000, 000,    NIL,    [nullSR, noisyErrClass, NIL]]];

        ltClass    _ NEW[TokenClassRep    _ [510, 500,    ReduceIntElt]];
        gtClass    _ NEW[TokenClassRep    _ [510, 500,    ReduceIntElt]];
        eqClass    _ NEW[TokenClassRep    _ [510, 500,    ReduceIntElt]];


        cedarClass    _ NEW[TokenClassRep    _ [000, 10000, SimplerReduce]];
        nameClass    _ NEW[TokenClassRep    _ [000, 10000, ReduceName]];

        errorClass    _ NEW[TokenClassRep    _ [250, 250,    ReduceError]];

        lambdaClass    _ NEW[TokenClassRep    _ [000, 150,    ReduceLambda]];
        returnClass    _ NEW[TokenClassRep    _ [150, 1000, NIL]];

        portsProcClass_ NEW[TokenClassRep    _ [080, 090,    ReducePortsProc]];
        applyClass    _ NEW[TokenClassRep    _ [810, 090,    ReduceApply]];
        sfClass    _ NEW[TokenClassRep    _ [080, 090,    ReduceStateFields]];
        isfClass    _ NEW[TokenClassRep    _ [080, 090,    ReduceInitStateFields]];
        initializerClass _ NEW[TokenClassRep    _ [080, 090,    ReduceInitializer]];
        testClass    _ NEW[TokenClassRep    _ [080, 090,    ReduceTest]];
        bbClass    _ NEW[TokenClassRep    _ [110, 100,    ReduceTestClass]];
        stClass    _ NEW[TokenClassRep    _ [110, 100,    ReduceTestClass]];
        refClass    _ NEW[TokenClassRep    _ [000, 100,    ReduceAuxVal]];
        recClass    _ NEW[TokenClassRep    _ [000, 100,    ReduceAuxVal]];
        ivClass    _ NEW[TokenClassRep    _ [000, 100,    ReduceAuxVal]];
        initCTPropsClass_ NEW[TokenClassRep_ [080, 090,    ReduceInitCTProps]];
        expandClass    _ NEW[TokenClassRep    _ [080, 090,    ReduceExpand]];
        portsClass    _ NEW[TokenClassRep    _ [080, 090,    ReducePorts]];

        cellClass    _ NEW[TokenClassRep    _ [000, 010,    ReduceCell]];
        cellEndClass_ NEW[TokenClassRep    _ [010, 000]];

        FOR et: EvalType IN EvalType DO
            evalClasses[et] _ NEW[TokenClassRep _ [80, 90, ReduceEval]];
            ops.Insert[NEW[OpRep _ [etNames[et], [evalClasses[et], NIL], TRUE]]];
            ENDLOOP;
        FOR ac: AuxClass IN AuxClass DO
            auxClasses[ac] _ NEW [TokenClassRep _ [80, 90, ReduceAuxClass]];
            ops.Insert[NEW[OpRep _ [auxClassNames[ac].Cat["Aux"], [auxClasses[ac], NIL]]]];
            ENDLOOP;

        ops.Insert[NEW[OpRep _ ["<",    [ltClass, NIL]]]];
        ops.Insert[NEW[OpRep _ [">",    [gtClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["=",    [eqClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["LAMBDA",    [NIL, lambdaClass]]]];
        ops.Insert[NEW[OpRep _ ["RETURN",    [returnClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["CELLTYPE", [NIL, cellClass]]]];
        ops.Insert[NEW[OpRep _ ["EndCellType", [cellEndClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["PORTS",    [portsClass,    NIL]]]];
        ops.Insert[NEW[OpRep _ ["PortsProc",    [portsProcClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["ApplyCode",[applyClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["State",    [sfClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["InittableState", [isfClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["Initializer",    [initializerClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["Expand",    [expandClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["CEDAR",    [NIL, cedarClass],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["NameMaker",[NIL, nameClass],    TRUE]]];
        ops.Insert[autoName_NEW[OpRep _ ["AutoName",[NIL, myArgClass]]]];
        ops.Insert[NEW[OpRep _ ["Test",    [testClass, NIL]]]];
        ops.Insert[NEW[OpRep _ ["StateToo",    [stClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["BlackBox",    [bbClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["InitCTProps", [initCTPropsClass, NIL], TRUE]]];
        ops.Insert[NEW[OpRep _ ["RefType",    [NIL, refClass]]]];
        ops.Insert[NEW[OpRep _ ["RecType",    [NIL, recClass]]]];
        ops.Insert[NEW[OpRep _ ["InitialValue", [NIL, ivClass]]]];

        arglikeError _ [nullSR, OPP.argClass, error];
        oplikeError _ [nullSR, errorClass, NIL];

        END;

    Setup[];

    END.