
<<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: 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] = {
<<"repairs" the tree IFF it is an hti leaf>>
WITH tree SELECT FROM 
hti: HTIndex => hti.name _ fix.Flatten[]
ENDCASE
}; 

END.