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.