BBUrpEvalImpl.mesa
Russ Atkinson, March 29, 1983 1:50 pm
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;
**** error routines ****
tryNonFatal: BOOLTRUE;
debuggingHelpRoutines: BOOLFALSE;
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] = {
"repairs" the tree IFF it is an hti leaf
WITH tree SELECT FROM
hti: HTIndex => hti.name ← fix.Flatten[]
ENDCASE
};
END.