DIRECTORY AMEvents USING [Debugging, Debugged], AMTypes USING [Error], BBApply USING [CoerceTV], BBEval USING [EvalHead, RopeOrTV, Tree], BBUrpEval USING [], PPLeaves USING [HTIndex], Rope USING [Flatten, ROPE], RTBasic USING [TV, Type]; BBUrpEvalImpl: CEDAR PROGRAM IMPORTS AMEvents, AMTypes, BBApply, Rope EXPORTS BBUrpEval SHARES BBEval = BEGIN OPEN BBEval, PPLeaves, Rope, RTBasic; tryNonFatal: BOOL _ TRUE; debuggingHelpRoutines: BOOL _ FALSE; UrpWrongType: PUBLIC PROC [head: EvalHead, parent: Tree, value: TV, target: Type, msg: ROPE] RETURNS [correct: TV] = TRUSTED { WHILE tryNonFatal AND head.helpWrongType # NIL DO new: RopeOrTV _ head.helpWrongType [head, parent, value, target, msg ! ABORTED => GO TO abort; AMEvents.Debugging, AMEvents.Debugged => REJECT; UNWIND => NULL; ANY => IF debuggingHelpRoutines THEN REJECT ELSE EXIT]; WITH n: new SELECT FROM tv => correct _ n.tv; both => correct _ n.tv; fail => {msg _ n.fail; EXIT}; ENDCASE => EXIT; RETURN [BBApply.CoerceTV [correct, target ! AMTypes.Error => IF reason = incompatibleTypes THEN EXIT ELSE REJECT]]; ENDLOOP; UrpFatal[head, parent, msg]; EXITS abort => ERROR ABORTED; }; UrpId: PUBLIC PROC [head: EvalHead, parent: Tree, id: ROPE, context, target: Type, msg: ROPE] RETURNS [correct: RopeOrTV _ [fail[NIL]]] = TRUSTED { WHILE tryNonFatal AND head.helpId # NIL DO new: RopeOrTV _ head.helpId [head, parent, id, context, target, msg ! ABORTED => GO TO abort; AMEvents.Debugging, AMEvents.Debugged => REJECT; UNWIND => NULL; ANY => IF debuggingHelpRoutines THEN REJECT ELSE EXIT]; 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, msg] EXITS abort => ERROR ABORTED; }; UrpSelector: PUBLIC PROC [head: EvalHead, parent: Tree, id: ROPE, context: TV, target: Type, msg: ROPE] RETURNS [correct: RopeOrTV _ [fail[NIL]]] = TRUSTED { WHILE tryNonFatal AND head.helpSelector # NIL DO new: RopeOrTV _ head.helpSelector [head, parent, id, context, target, msg ! ABORTED => GO TO abort; AMEvents.Debugging, AMEvents.Debugged => REJECT; UNWIND => NULL; ANY => IF debuggingHelpRoutines THEN REJECT ELSE EXIT]; WITH n: new SELECT FROM fail => msg _ n.fail ENDCASE => RETURN [new]; EXIT ENDLOOP; UrpFatal[head, parent, msg] EXITS abort => ERROR ABORTED; }; UrpDefault: PUBLIC PROC [head: EvalHead, parent: Tree, type: Type, index: CARDINAL, msg: ROPE] RETURNS [correct: TV] = TRUSTED { WHILE tryNonFatal AND head.helpDefault # NIL DO new: RopeOrTV _ head.helpDefault [head, parent, type, index, msg ! ABORTED => GO TO abort; AMEvents.Debugging, AMEvents.Debugged => REJECT; UNWIND => NULL; ANY => IF debuggingHelpRoutines THEN REJECT ELSE EXIT]; WITH n: new SELECT FROM tv => RETURN [n.tv]; fail => msg _ n.fail ENDCASE; EXIT ENDLOOP; UrpFatal[head, parent, msg] EXITS abort => ERROR ABORTED; }; UrpFatal: PUBLIC PROC [head: EvalHead, parent: Tree, msg: ROPE] = TRUSTED { DO head.helpFatal[head, parent, msg] ENDLOOP }; FixHti: PROC [tree: Tree, fix: ROPE] = { WITH tree SELECT FROM hti: HTIndex => hti.name _ fix.Flatten[] ENDCASE }; END. ‚BBUrpEvalImpl.mesa Russ Atkinson, March 29, 1983 1:50 pm **** error routines **** "repairs" the tree IFF it is an hti leaf Êa˜Jšœ™Jšœ%™%J˜šÏk ˜ Jšœ œ˜%Jšœœ ˜Jšœœ ˜Jšœœ˜(Jšœ œ˜Jšœ œ ˜Jšœœ œ˜Jšœœœ˜J˜—šœœ˜Jšœ!˜(Jšœ ˜Jšœ˜Jšœœœ!˜-J˜Jšœ™J˜Jšœ œœ˜Jšœœœ˜$J˜šÏn œœ˜Jšœ&œœ˜BJšœ œœ˜!šœ œœœ˜2˜˜˜!šœœœœ˜Jšœ)œ˜0Jšœœ˜Jš œœœœœœ˜7————šœœœ˜J˜J˜Jšœœ˜Jšœœ˜—š˜˜˜Jš œœœœœœ˜I———Jšœ˜ —J˜Jšœ œœ˜J˜J˜—šžœœ˜Jšœ#œœ˜JJšœœœ˜5šœ œœœ˜+˜˜ ˜'šœœœœ˜Jšœ)œ˜0Jšœœ˜Jš œœœœœœ˜8————šœœ˜J˜ J˜Jšœœ˜Jšœ˜—Jšœ˜ Jšœ˜ —J˜Jšœ œœ˜J˜J˜—šž œœ˜Jšœ#œ œœ˜NJšœœœ˜5šœ œœœ˜1˜˜˜'šœœœœ˜Jšœ)œ˜0Jšœœ˜Jš œœœœœœ˜8————šœœœ˜J˜Jšœœ˜—Jš˜Jšœ˜ —J˜Jšœ œœ˜J˜J˜—šž œœ˜Jšœ2œœ˜FJšœ œœ˜!šœ œœœ˜0˜˜˜šœœœœ˜Jšœ)œ˜0Jšœœ˜Jš œœœœœœ˜7————šœœœ˜Jšœœ˜J˜Jšœ˜ —Jš˜Jšœ˜ —J˜Jšœ œœ˜J˜J˜—š žœœœ%œœ˜Kšœ"˜$Jš˜—J˜J˜—šžœœœ˜(Jšœ(™(šœœœ˜J˜(Jš˜—J˜J˜—Jšœ˜ J˜J˜J˜J˜——…— dG