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.