
<<RoseTranslateRead.Mesa>>
<<Last Edited by: Spreitzer, July 26, 1983 9:43 am>>
<<Last Edited by: Barth, March 8, 1983 10:43 am>>

    DIRECTORY
        IO, OpPrecParse, OrderedSymbolTableRef, Rope, RoseTranslateTypes, RoseTranslateInsides, TiogaStreams, UserExec;

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

    BEGIN OPEN RoseTranslateTypes, RoseTranslateInsides;

    viewerLog: PUBLIC IO.STREAM _ IO.CreateViewerStreams["RoseTranslate.Log"].out;

    omitted: PUBLIC REF ANY _ NEW [INT _ 99];

    defaultST: PUBLIC SignalType _ NIL;

    arglikeError, oplikeError: OPP.Token;

    ops: SymbolTable _ OSTR.CreateTable[CompareOps];

    colonClass, twiddleClass, ltClass, gtClass, eqClass, commaClass, squareClass, applClass, rsClass, semiClass, cellClass, initClass, 
    defaultInitExprClass, defaultInitDataClass, initDataClass, stateClass, initStateClass, initializerClass, expandClass, 
    cedarClass, evalClass, testClass, endClass, errorClass, directoryClass, importsClass, openClass, libClass, noisyErrClass, 
    myArgClass: TokenClass;

    Setup: PROC =
        BEGIN

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

        twiddleClass _ NEW[TokenClassRep    _ [610,    600,    ReduceTwiddle]];

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

        initClass    _ NEW[TokenClassRep    _ [450,    1500,    ReduceInit]];

        colonClass    _ NEW[TokenClassRep    _ [410,    400,    ReduceBinding]];

        commaClass    _ NEW[TokenClassRep    _ [310,    300,    ReduceComma, [OPP.argClass, omitted]]];

        cedarClass    _ NEW[TokenClassRep    _ [0,    10000,    SimplerReduce]];

        directoryClass _ NEW[TokenClassRep    _ [0,    275,    ReduceDirectory]];
        importsClass    _ NEW[TokenClassRep    _ [0,    275,    ReduceImports]];
        openClass    _ NEW[TokenClassRep    _ [0,    275,    ReduceOpen]];
        libClass    _ NEW[TokenClassRep    _ [0,    275,    ReduceLibrary]];

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

        squareClass    _ NEW[TokenClassRep    _ [0,    200,    ReduceSquare]];
        applClass    _ NEW[TokenClassRep    _ [1000,    200,    ReduceAppl]];
        rsClass    _ NEW[TokenClassRep    _ [200,    0,    NIL,    [OPP.argClass, omitted]]];

        semiClass    _ NEW[TokenClassRep    _ [110,    100,    ReduceSemi]];

        defaultInitExprClass _ NEW[TokenClassRep _ [80,    1500,    ReduceDefaultInitExpr]];
        defaultInitDataClass _ NEW[TokenClassRep _ [80,    90,    ReduceDefaultInitData]];
        initDataClass _ NEW[TokenClassRep    _ [80,    90,    ReduceInitData]];
        stateClass    _ NEW[TokenClassRep    _ [80,    90,    ReduceState]];
        initStateClass _ NEW[TokenClassRep    _ [80,    90,    ReduceInitState]];
        initializerClass _ NEW[TokenClassRep    _ [80,    90,    ReduceInitializer]];
        evalClass    _ NEW[TokenClassRep    _ [80,    90,    ReduceEval]];
        testClass    _ NEW[TokenClassRep    _ [80,    90,    ReduceTest]];
        expandClass    _ NEW[TokenClassRep    _ [80,    90,    ReduceExpand]];

        cellClass    _ NEW[TokenClassRep    _ [0,    10,    ReduceCell]];
        endClass    _ NEW[TokenClassRep    _ [10,    0]];

        ops.Insert[NEW[OpRep _ [":",    [colonClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ ["~",    [twiddleClass,    NIL]]]];
        ops.Insert[NEW[OpRep _ ["<",    [ltClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ [">",    [gtClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ ["=",    [eqClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ [",",    [commaClass,    commaClass]]]];
        ops.Insert[NEW[OpRep _ ["[",    [applClass,        squareClass]]]];
        ops.Insert[NEW[OpRep _ ["]",    [rsClass,        rsClass]]]];
        ops.Insert[NEW[OpRep _ [";",    [semiClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ ["CELL",    [NIL,        cellClass]]]];
        ops.Insert[NEW[OpRep _ ["NULL",    [NIL,        myArgClass]]]];
        ops.Insert[NEW[OpRep _ ["init",    [initClass,        NIL],    TRUE, FALSE, FALSE]]];
        ops.Insert[NEW[OpRep _ ["DefaultInitExpr", [defaultInitExprClass, NIL],    TRUE, FALSE, FALSE]]];
        ops.Insert[NEW[OpRep _ ["DefaultInitData", [defaultInitDataClass, NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["InitData",    [initDataClass,    NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["State",    [stateClass,        NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["InitState",    [initStateClass,    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 _ ["Eval",    [evalClass,        NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["Test",    [testClass,        NIL],    TRUE]]];
        ops.Insert[NEW[OpRep _ ["EndCell",    [endClass,        NIL]]]];
        ops.Insert[NEW[OpRep _ ["Directory",    [NIL,        directoryClass]]]];
        ops.Insert[NEW[OpRep _ ["Imports",    [NIL,        importsClass]]]];
        ops.Insert[NEW[OpRep _ ["Open",    [NIL,        openClass]]]];
        ops.Insert[NEW[OpRep _ ["Library",    [NIL,        libClass]]]];
        ops.Insert[NEW[OpRep _ ["!!",    [OPP.end.class,    NIL],    FALSE, TRUE]]];

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

        END;

    SetDefaultSignalType: PUBLIC PROC [st: SignalType] = {defaultST _ st};

    AddOpen: PUBLIC PROC [job: Job, name: ROPE] =
        BEGIN
        IF job.opened.Lookup[name] # NIL THEN RETURN;
        job.opened.Insert[name];
        IF NOT job.emptyOpen THEN job.openStream.PutRope[", "];
        job.openStream.PutRope[name]; job.emptyOpen _ FALSE;
        AddDirectory[job, name];
        END;

    AddImport: PUBLIC PROC [job: Job, name: ROPE] =
        BEGIN
        IF job.imports.Lookup[name] # NIL THEN RETURN;
        job.imports.Insert[name];
        IF NOT job.emptyImports THEN job.importsStream.PutRope[", "];
        job.importsStream.PutRope[name]; job.emptyImports _ FALSE;
        AddDirectory[job, name];
        END;

    AddDirectory: PUBLIC PROC [job: Job, name: ROPE] =
        BEGIN
        IF job.directory.Lookup[name] # NIL THEN RETURN;
        job.directory.Insert[name];
        IF NOT job.emptyDirectory THEN job.directoryStream.PutRope[", "];
        job.directoryStream.PutRope[name]; job.emptyDirectory _ FALSE;
        END;

    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 => sepr,
            ENDCASE => break]};

    ParseExpression: PUBLIC PROC [job: Job, stoppable: BOOLEAN] RETURNS [expr: REF ANY, next: ROPE] =
        BEGIN

        GetToken: OPP.TokenProc =
            BEGIN
            asRope: ROPE;
            op: Op;
            peek: CHAR;
            WHILE TRUE DO
                IF job.exec.UserAbort[] THEN UserExec.UserAborted[job.exec];
                IF useOld THEN {useOld _ FALSE; RETURN [[myArgClass, old]]};
                job.from.SkipOver[IO.WhiteSpace];
                IF railed THEN asRope _ "!!"
                ELSE IF job.from.EndOf[] THEN asRope _ "!!"
                ELSE BEGIN
                    job.tokenCount _ job.tokenCount + 1;
                    peek _ job.from.PeekChar[];
                    IF peek = '" THEN
                        BEGIN
                        asAny: REF ANY _ IO.GetRefAny[job.from];
                        asRope: ROPE _ NARROW[asAny];
                        RETURN [[myArgClass, NEW [QuotedRep _ [asRope]] ]];
                        END;
                    IF peek IN ['0..'9] THEN
                        BEGIN
                        i: INT _ job.from.GetInt[];
                        RETURN [[myArgClass, NEW[INT _ i] ]];
                        END;
                    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 asRope _ "-";
                        END
                    ELSE IF peek = '! AND stoppable THEN
                        BEGIN
                        IF job.from.GetChar[] # '! THEN ERROR;
                        IF job.from.PeekChar[] = '! THEN {[] _ job.from.GetChar[]; asRope _ "!!"}
                        ELSE asRope _ "!";
                        END
                    ELSE asRope _ job.from.GetToken[MyBreak];
                    END;
                op _ NARROW[ops.Lookup[asRope]];
                IF op = NIL THEN RETURN [[myArgClass, asRope]];
                IF op.terminal THEN {railed _ TRUE; next _ asRope};
                IF op.eatsCedar THEN
                    BEGIN
                    IF op.childish THEN
                        BEGIN
                        char: CHAR _ job.from.GetChar[];    --counter Backup in GetToken
                        --to allow comments there, don't test: IF char # '\n THEN ERROR;
                        old _ NEW [CedarSourceRep _ [TS.CurInNode[job.from] ]];
                        TS.SkipChildren[job.from];
                        END
                    ELSE BEGIN
                        cedar: ROPE _ NIL;
                        job.from.SkipOver[IO.WhiteSpace];
                        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;
                        old _ NEW [CedarLiteralRep _ [cedar]];
                        END;
                    useOld _ TRUE;
                    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 [[op.class[expectingArg], op.asArg[expectingArg]]];
                ENDLOOP;
            END;

        railed: BOOLEAN _ FALSE;
        useOld: BOOLEAN _ FALSE;
        old: REF ANY _ NIL;

        next _ NIL;

        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;

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

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

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

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

    ReduceSquare: OPP.Reducer =
        BEGIN
        IF ErrCheck[args] THEN RETURN [error];
        IF args.first = omitted THEN reduced _ NEW [SquareBracketedRep _ [NIL]]
        ELSE WITH args.first SELECT FROM
            iel: InterfaceEltList => reduced _ NEW [SquareBracketedRep _ [iel]];
            ie: InterfaceElt => reduced _ NEW[SquareBracketedRep _ [LIST[ie]]];
            ENDCASE => reduced _ Complain[context, "Surroundfix square brackets are used only to construct Interfaces... applying them to %g is 
            garbage", IO.refAny[args.first]];
        END;

    ReduceBinding: OPP.Reducer =
        BEGIN
        b: Binding _ NEW [BindingRep];
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first SELECT FROM
            r: ROPE => b.name _ r;
            ENDCASE => RETURN [Complain[context, "Can't Bind %g", IO.refAny[args.first]]];
        WITH args.rest.first SELECT FROM
            r: ROPE => NULL;
            x: SignalTypeInvocation => NULL;
            x: Application => NULL;
            x: CellDef => NULL;
            ENDCASE => RETURN [Complain[context, "Can't Bind %g to %g", IO.refAny[b.name], IO.refAny[args.rest.first]]];
        b.value _ args.rest.first;
        reduced _ b;
        END;

    ReduceComma: OPP.Reducer =
        BEGIN
        rest: REF ANY;
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.rest.first SELECT FROM
            b: Binding => {bl: BindingList _ LIST[b]; rest _ bl};
            ie: InterfaceElt => {i: InterfaceEltList _ LIST[ie]; rest _ i};
            r: ROPE => rest _ NEW[ArgsRep _ [LIST[r]]];
            q: Quoted => rest _ NEW[ArgsRep _ [LIST[q]]];
            ri: REF INT => rest _ NEW [ArgsRep _ [LIST[ri]]];
            x: BindingList => rest _ args.rest.first;
            x: InterfaceEltList => rest _ args.rest.first;
            x: Args => rest _ args.rest.first;
            ENDCASE => RETURN [Complain[context, "Can't catenate %g to %g", IO.refAny[args.first], IO.refAny[args.rest.first]]];
        WITH rest SELECT FROM
            bl: BindingList => WITH args.first SELECT FROM
                b: Binding => {bl _ CONS[b, bl]; reduced _ bl};
                r: ROPE => {bl _ CONS[NEW[BindingRep _ [name: r, value: bl.first.value]], bl]; reduced _ bl};
                ENDCASE => reduced _ Complain[context, "Cant prepend %g to BindingList %g", IO.refAny[args.first], IO.refAny[args.rest.first]];
            i: InterfaceEltList => WITH args.first SELECT FROM
                ie: InterfaceElt => {i _ CONS[ie, i]; reduced _ i};
                r: ROPE => {i _ CONS[NEW[InterfaceEltRep _ i.first^], i]; i.first.name _ r; reduced _ i};
                ENDCASE => reduced _ Complain[context, "Can't prepend %g to Interface %g", IO.refAny[args.first], IO.refAny[args.rest.first]];
            as: Args => WITH args.first SELECT FROM
                r: ROPE => {as.args _ CONS[r, as.args]; reduced _ as};
                q: Quoted => {as.args _ CONS[q, as.args]; reduced _ as};
                ri: REF INT => {as.args _ CONS[ri, as.args]; reduced _ as};
                ENDCASE => reduced _ Complain[context, "Can't prepend %g to Args %g", IO.refAny[args.first], IO.refAny[args.rest]];
            ENDCASE => ERROR;
        END;

    ReduceTwiddle: OPP.Reducer =
        BEGIN
        left: SignalTypeInvocation;
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first SELECT FROM
            r: ROPE => IF (left _ InstantiateSignalType[context, r, NIL]) = NIL THEN RETURN [error];
            sti: SignalTypeInvocation => left _ sti;
            ENDCASE => RETURN [Complain[context, "Cant force %g on %g", IO.refAny[args.rest.first], IO.refAny[args.first]]];
        WITH args.rest.first SELECT FROM
            q: Quoted => {left.st _ ForceMesaType[q.rope, left.st]; reduced _ left};
            ENDCASE => reduced _ Complain[context, "Can't force %g on %g", IO.refAny[args.rest.first], IO.refAny[args.first]];
        END;

    ReduceSemi: OPP.Reducer =
        BEGIN
        IF ErrCheck[args] THEN RETURN [error];
        IF args.first = ignoreMe THEN RETURN [args.rest.first];
        IF args.rest.first = ignoreMe THEN RETURN [args.first];
        WITH args.first SELECT FROM
            x: Binding => NULL;
            y: BindingList => NULL;
            cs: CedarSource => NULL;
            ENDCASE => RETURN [Complain[context, "%g not a valid statement", IO.refAny[args.first]]];
        WITH args.rest.first SELECT FROM
            stmts: Statements => {stmts.statements _ CONS[args.first, stmts.statements]; reduced _ stmts};
            x: Binding => reduced _ NEW [StatementsRep _ [args]];
            y: BindingList => reduced _ NEW [StatementsRep _ [args]];
            cs: CedarSource => reduced _ NEW [StatementsRep _ [args]];
            ENDCASE => RETURN [Complain[context, "%g not a valid statement", IO.refAny[args.rest.first]]];
        END;

    ReduceDirectory: OPP.Reducer =
        BEGIN
        job: Job _ NARROW[context];
        reduced _ ignoreMe;
        WITH args.first SELECT FROM
            a: Args => FOR l: LIST OF Arg _ a.args, l.rest WHILE l # NIL DO
                WITH l.first SELECT FROM
                    r: ROPE => AddDirectory[job, r];
                    ENDCASE => RETURN [Complain[context, "DIRECTORY only takes IDs, not %g", IO.refAny[l.first]]];
                ENDLOOP;
            r: ROPE => AddDirectory[job, r];
            ENDCASE => reduced _ Complain[context, "DIRECTORY must be given an ID or IDList, not %g", IO.refAny[args.first]];
        END;

    ReduceImports: OPP.Reducer =
        BEGIN
        job: Job _ NARROW[context];
        reduced _ ignoreMe;
        WITH args.first SELECT FROM
            a: Args => FOR l: LIST OF Arg _ a.args, l.rest WHILE l # NIL DO
                WITH l.first SELECT FROM
                    r: ROPE => AddImport[job, r];
                    ENDCASE => RETURN [Complain[context, "IMPORTS only takes IDs, not %g", IO.refAny[l.first]]];
                ENDLOOP;
            r: ROPE => AddImport[job, r];
            ENDCASE => reduced _ Complain[context, "IMPORTS must be given an ID or IDList, not %g", IO.refAny[args.first]];
        END;

    ReduceOpen: OPP.Reducer =
        BEGIN
        job: Job _ NARROW[context];
        reduced _ ignoreMe;
        WITH args.first SELECT FROM
            a: Args => FOR l: LIST OF Arg _ a.args, l.rest WHILE l # NIL DO
                WITH l.first SELECT FROM
                    r: ROPE => AddOpen[job, r];
                    ENDCASE => RETURN [Complain[context, "OPEN only takes IDs, not %g", IO.refAny[l.first]]];
                ENDLOOP;
            r: ROPE => AddOpen[job, r];
            ENDCASE => reduced _ Complain[context, "OPEN must be given an ID or IDList, not %g", IO.refAny[args.first]];
        END;

    ReduceLibrary: OPP.Reducer =
        BEGIN
        job: Job _ NARROW[context];
        reduced _ ignoreMe;
        WITH args.first SELECT FROM
            a: Args => FOR l: LIST OF Arg _ a.args, l.rest WHILE l # NIL DO
                WITH l.first SELECT FROM
                    r: ROPE => AddSymbols[job, r];
                    ENDCASE => RETURN [Complain[context, "LIBRARY only takes IDs, not %g", IO.refAny[l.first]]];
                ENDLOOP;
            r: ROPE => AddSymbols[job, r];
            ENDCASE => reduced _ Complain[context, "LIBRARY must be given an ID or IDList, not %g", IO.refAny[args.first]];
        END;

    ReduceIntElt: OPP.Reducer =
        BEGIN
        ie: InterfaceElt _ NEW [InterfaceEltRep _ []];
        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 SELECT FROM
            r: ROPE => ie.name _ r;
            ENDCASE => RETURN [Complain[context, "An Interface Element must be identified by an ID, not %g", IO.refAny[args.first]]];
        IF args.rest.first = omitted THEN ie.sti _ NEW [SignalTypeInvocationRep _ [defaultST, [NIL, NIL]]]
        ELSE WITH args.rest.first SELECT FROM
            sti: SignalTypeInvocation => ie.sti _ sti;
            r: ROPE => IF (ie.sti _ InstantiateSignalType[context, r, NIL]) = NIL THEN RETURN [error];
            ENDCASE => RETURN [Complain[context, "An Interface Element must use a Signal Type, not %g", IO.refAny[args.rest.first]]];
        reduced _ ie;
        END;

    ReduceAppl: OPP.Reducer =
        BEGIN    --making either signal type invocation or cell instance
        fn: ROPE;
        asAny: REF ANY;
        job: Job _ NARROW[context];
        parms: REF ANY;
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.first SELECT FROM
            r: ROPE => fn _ r;
            ENDCASE => RETURN [Complain[context, "Must Apply %g to a simple ID, not %g", IO.refAny[args.rest.first], IO.refAny[args.first]]];
        IF args.rest.first = omitted THEN parms _ NEW [ArgsRep _ [NIL]]
        ELSE WITH args.rest.first SELECT FROM
            ri: REF INT => parms _ NEW [ArgsRep _ [LIST[ri]]];
            q: Quoted => parms _ NEW [ArgsRep _ [LIST[q]]];
            r: ROPE => parms _ NEW [ArgsRep _ [LIST[r]]];
            a: Args => parms _ a;
            b: Binding => {bl: BindingList _ LIST[b]; parms _ bl};
            bl: BindingList => parms _ bl;
            ENDCASE => RETURN [Complain[context, "Must apply to %g a BindingList or ArgList, not %g", IO.rope[fn], IO.refAny[args.rest.first]]];
        IF (asAny _ signalTypes.Lookup[fn]) # NIL THEN
            BEGIN
            reduced _ InstantiateSignalType[context, fn, parms];
            END
        ELSE reduced _ NEW [ApplicationRep _ [fn, parms]];
        END;

    ReduceInit: OPP.Reducer =
        BEGIN
        id: ROPE;
        IF ErrCheck[args] THEN RETURN [error];
        WITH args.rest.first SELECT FROM
            cl: CedarLiteral => id _ cl.cedar;
            ENDCASE => RETURN [Complain[context, "Must init with a CEDAR literal, not %g", IO.refAny[args.rest.first]]];
        WITH args.first SELECT FROM
            a: Application => a.initData _ id;
            ENDCASE => RETURN [Complain[context, "Must init an application, not %g", IO.refAny[args.first]]];
        reduced _ args.first;
        END;

    InstantiateSignalType: PUBLIC PROC [context: REF ANY, name: ROPE, parms: REF ANY] RETURNS [sti: SignalTypeInvocation] =
        BEGIN
        job: Job _ NARROW[context];
        stce: stcEntry _ NARROW[signalTypes.Lookup[name]];
        IF stce = NIL THEN {[] _ Complain[context, "Signal Type %g Undefined", IO.rope[name]]; RETURN [NIL]};
        sti _ NEW [SignalTypeInvocationRep _ [NIL, [name, parms]]];
        sti.st _ stce.stc[parms !TypeConstructionError =>
            BEGIN
            [] _ Complain[context, msg];
            sti _ NIL;
            CONTINUE;
            END];
        END;

    Sofar: PROC [context, org: REF ANY] RETURNS [cd: CellDef] =
        BEGIN
        IF org = NIL THEN RETURN [NEW [CellDefRep _ [interface: DigestInterface[context, NIL]]]];
        WITH org SELECT FROM
            cellDef: CellDef => RETURN [cellDef];
            sb: SquareBracketed => {cd _ NEW [CellDefRep _ [interface: DigestInterface[context, sb.iel]]]; IF cd.interface = NIL THEN cd _ NIL};
            ENDCASE => {[] _ Complain[context, "Bad Cell header: %g", IO.refAny[org]]; cd _ NIL};
        END;

    InsistOnCedarSource: PROC [context: REF ANY, sofar: CellDef, args: LORA] RETURNS [cs: CedarSource, reduced: REF ANY] =
        BEGIN
        WITH args.rest.first SELECT FROM
            cedar: CedarSource => {cs _ cedar; reduced _ sofar};
            ENDCASE => {cs _ NIL; reduced _ Complain[context, "Internal Error"]};
        END;

    ReduceCell: OPP.Reducer =
        BEGIN
        IF ErrCheck[args] THEN RETURN [error];
        IF (reduced _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        END;

    ReduceDefaultInitData: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.defaultInitDataGiven THEN Whimper[context, "Redefining default Init Data"];
        sofar.defaultInitDataGiven _ TRUE;
        [sofar.defaultInitDataSource, reduced] _ InsistOnCedarSource[context, sofar, args];
        END;

    ReduceDefaultInitExpr: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        WITH args.rest.first SELECT FROM
            cl: CedarLiteral => sofar.defaultInitExpr _ cl.cedar;
            ENDCASE => RETURN [Complain[context, "Found %g when expecting a CEDAR literal", IO.refAny[args.rest.first]]];
        IF sofar.defaultInitExprGiven THEN Whimper[context, "Redefining default Init Expression"];
        sofar.defaultInitExprGiven _ TRUE;
        reduced _ sofar;
        END;

    ReduceInitData: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.initDataGiven THEN Whimper[context, "Redefining Init Data"];
        sofar.initDataGiven _ TRUE;
        [sofar.initDataSource, reduced] _ InsistOnCedarSource[context, sofar, args];
        END;

    ReduceState: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.stateGiven THEN Whimper[context, "Redefining State Vector"];
        sofar.stateGiven _ TRUE;
        [sofar.stateSource, reduced] _ InsistOnCedarSource[context, sofar, args];
        sofar.stateInittable _ FALSE;
        END;

    ReduceInitState: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.stateGiven THEN Whimper[context, "Redefining State Vector"];
        sofar.stateGiven _ TRUE;
        [sofar.stateSource, reduced] _ InsistOnCedarSource[context, sofar, args];
        sofar.stateInittable _ TRUE;
        END;

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

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

    ReduceEval: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.evalGiven THEN Whimper[context, "Redefining Eval Proc"];
        sofar.evalGiven _ TRUE;
        [sofar.evalSource, reduced] _ InsistOnCedarSource[context, sofar, args];
        END;

    ReduceTest: OPP.Reducer =
        BEGIN
        sofar: CellDef;
        IF ErrCheck[args] THEN RETURN [error];
        IF (sofar _ Sofar[context, args.first]) = NIL THEN RETURN [error];
        IF sofar.testGiven THEN Whimper[context, "Redefining Test Proc"];
        sofar.testGiven _ TRUE;
        [sofar.testSource, reduced] _ InsistOnCedarSource[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;

    Setup[];

    END.