
    <<BBUrpEvalImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson, February 12, 1985 4:04:02 pm PST>>
        <<Paul Rovner, November 1, 1983 11:06 pm>>

    DIRECTORY
        AMTypes USING [Error, TV, Type],
        InterpreterOps USING [EvalHead, RopeOrTV, Tree],
        InterpreterPrivate USING [CoerceTV],
        BBUrpEval USING [],
        PPLeaves USING [HTIndex], 
        Rope USING [Flatten, ROPE, Cat];

    BBUrpEvalImpl: CEDAR PROGRAM
        IMPORTS AMTypes, InterpreterPrivate, Rope
        EXPORTS BBUrpEval
        = BEGIN OPEN AMTypes, InterpreterOps, PPLeaves, Rope;

        <<**** error routines ****>>

        Error: ERROR[msg: ROPE] = CODE;

        UrpWrongType: PUBLIC PROC [head: EvalHead, parent: Tree, value: TV, target: Type, msg: ROPE] RETURNS [correct: TV] = TRUSTED {
            WHILE head.helpWrongTypeClosure.proc # NIL DO 
                new: RopeOrTV _ 
                    head.helpWrongTypeClosure.proc
                        [head.helpWrongTypeClosure.data, head, parent, value, target, msg];
                WITH n: new SELECT FROM 
                    tv => correct _ n.tv;
                    both => correct _ n.tv;
                    fail => {msg _ n.fail; EXIT};
                    ENDCASE => EXIT; 
                RETURN
                    [InterpreterPrivate.CoerceTV
                        [correct, target
                            ! AMTypes.Error => IF reason = incompatibleTypes THEN EXIT ELSE REJECT]];
                ENDLOOP; 
            UrpFatal[head, parent, msg];
            }; 

        UrpId: PUBLIC PROC [head: EvalHead, parent: Tree, id: ROPE, context, target: Type, msg: ROPE] RETURNS [correct: RopeOrTV _ 
        [fail[NIL]]] = TRUSTED {
            WHILE head.helpIdClosure.proc # NIL DO 
                new: RopeOrTV _ 
                    head.helpIdClosure.proc
                        [head.helpIdClosure.data, head, parent, id, context, target, msg];
                WITH n: new SELECT FROM
                    both => FixHti[parent, n.rope]; 
                    rope => FixHti[parent, n.rope];
                    fail => {msg _ n.fail; EXIT};
                    ENDCASE;
                RETURN [new];
                ENDLOOP; 
            UrpFatal[head, parent, id.Cat[": ", msg]]
            }; 

        UrpSelector: PUBLIC PROC [head: EvalHead, parent: Tree, id: ROPE, context: TV, target: Type, msg: ROPE] RETURNS [correct: RopeOrTV 
        _ [fail[NIL]]] = TRUSTED {
            WHILE head.helpSelectorClosure.proc # NIL DO 
                new: RopeOrTV _ 
                    head.helpSelectorClosure.proc
                        [head.helpSelectorClosure.data, head, parent, id, context, target, msg];
                WITH n: new SELECT FROM 
                    fail => msg _ n.fail
                    ENDCASE => RETURN [new]; 
                EXIT
                ENDLOOP; 
            UrpFatal[head, parent, msg]
            }; 

        UrpDefault: PUBLIC PROC [head: EvalHead, parent: Tree, type: Type, index: CARDINAL, msg: ROPE] RETURNS [correct: TV] = TRUSTED {
            WHILE head.helpDefaultClosure.proc # NIL DO 
                new: RopeOrTV _
                    head.helpDefaultClosure.proc
                        [head.helpDefaultClosure.data, head, parent, type, index, msg];
                WITH n: new SELECT FROM 
                    tv => RETURN [n.tv];
                    fail => msg _ n.fail
                    ENDCASE; 
                EXIT
                ENDLOOP; 
            UrpFatal[head, parent, msg]
            }; 

        UrpFatal: PUBLIC PROC [head: EvalHead, parent: Tree, msg: ROPE] = TRUSTED {
            IF head.helpFatalClosure.proc # NIL THEN
                DO head.helpFatalClosure.proc[head.helpFatalClosure.data, head, parent, msg]
                ENDLOOP;
            ERROR Error[msg];
            };

        FixHti: PROC [tree: Tree, fix: ROPE] = {
            <<"repairs" the tree IFF it is an hti leaf>>
            WITH tree SELECT FROM 
                hti: HTIndex => hti.name _ fix.Flatten[]
                ENDCASE
            }; 

        END.