RoseConditionsImpl.Mesa
Last Edited by: Spreitzer, November 19, 1983 7:57 pm
DIRECTORY
IO, Rope, RoseEvents, RoseTypes, RoseConditions, Trees;
RoseConditionsImpl: CEDAR PROGRAM
IMPORTS IO, Rope, RoseEvents, RoseTypes, Trees
EXPORTS RoseConditions =
BEGIN OPEN RoseConditions;
ROPE: TYPE = Rope.ROPE;
Cell: TYPE = RoseTypes.Cell;
IncrementalCondition: TYPE = REF IncrementalConditionRep;
IncrementalConditionRep: PUBLIC TYPE = RECORD [
eval: IncrementalEvalProc ← NIL,
data: REF ANYNIL,
parent: IncrementalCondition ← NIL,
sibling: IncrementalCondition ← NIL,
value, sensitiveTo: BOOLEANFALSE];
IncrementalEvalProc: TYPE = PROC [ic: IncrementalCondition];
test: PUBLIC Trees.NodeType;
UnPostIncrementally: PUBLIC PROC [ic: IncrementalCondition] =
BEGIN
SELECT ic.eval FROM
IETop => UnPostIncrementally[NARROW[ic.data, TopData].child];
IEAnd, IEOr, IENot => FOR child: IncrementalCondition ← NARROW[ic.data], child.sibling WHILE child # NIL DO
UnPostIncrementally[child];
ENDLOOP;
IETest => BEGIN
nt: NodeTest ← NARROW[ic.data];
RoseEvents.RemoveWatcher[$ChangeLate, [NotifyIncremental, ic], nt.node];
END;
ENDCASE => ERROR;
END;
PostIncrementally: PUBLIC PROC [cond: Condition] RETURNS [ic: IncrementalCondition] =
BEGIN
ic ← NEW [IncrementalConditionRep ← [eval: IETop, sensitiveTo: TRUE]];
ic.data ← NEW [TopDataRep ← [
cond: cond,
child: PostIE[parent: ic, cond: cond] ]];
END;
TopData: TYPE = REF TopDataRep;
TopDataRep: TYPE = RECORD [
cond: Condition,
child: IncrementalCondition];
IETop: IncrementalEvalProc =
BEGIN
td: TopData ← NARROW[ic.data];
IF td.child.value THEN SIGNAL RoseTypes.Stop["Incremental Breakpoint hit", td.cond];
END;
PostIE: PROC [parent: IncrementalCondition, cond: Condition] RETURNS [ic: IncrementalCondition] =
BEGIN
recurse: BOOLEANTRUE;
last: IncrementalCondition ← NIL;
ic ← NEW [IncrementalConditionRep ← [parent: parent]];
SELECT cond.info FROM
test => BEGIN
nt: NodeTest ← NARROW[cond.leftChild];
ic.eval ← IETest;
ic.data ← cond.leftChild;
recurse ← FALSE;
RoseEvents.AddWatcher[$ChangeLate, [NotifyIncremental, ic], nt.node];
END;
Trees.and => ic.eval ← IEAnd;
Trees.or => ic.eval ← IEOr;
Trees.not => ic.eval ← IENot;
ENDCASE => ERROR;
IF recurse THEN
BEGIN
FOR c: Condition ← NARROW[cond.leftChild], c.rightSibling WHILE c # NIL DO
next: IncrementalCondition ← PostIE[parent: ic, cond: c];
next.sibling ← last;
last ← next;
ENDLOOP;
ic.data ← last;
END;
ic.eval[ic];
END;
NotifyIncremental: RoseTypes.NotifyProc =
BEGIN
IncrementalEval[NARROW[watcherData]];
END;
IncrementalEval: PROC [ic: IncrementalCondition] =
BEGIN
old: BOOLEAN ← ic.value;
ic.eval[ic];
IF ic.value # old AND ic.value = ic.parent.sensitiveTo AND ic.parent # NIL THEN IncrementalEval[ic.parent];
END;
IETest: IncrementalEvalProc =
BEGIN
nt: NodeTest ← NARROW[ic.data];
ic.sensitiveTo ← NOT (ic.value ← nt.testProc[testData: nt.testData, nodeType: nt.node.type, where: nt.node.visible.SocketToWP[]]);
END;
IEAnd: IncrementalEvalProc =
BEGIN
FOR child: IncrementalCondition ← NARROW[ic.data], child.sibling WHILE child # NIL DO
IF NOT child.value THEN
BEGIN
ic.sensitiveTo ← NOT (ic.value ← FALSE);
EXIT;
END;
ENDLOOP;
ic.sensitiveTo ← NOT (ic.value ← TRUE);
END;
IEOr: IncrementalEvalProc =
BEGIN
FOR child: IncrementalCondition ← NARROW[ic.data], child.sibling WHILE child # NIL DO
IF child.value THEN
BEGIN
ic.sensitiveTo ← NOT (ic.value ← TRUE);
EXIT;
END;
ENDLOOP;
ic.sensitiveTo ← NOT (ic.value ← FALSE);
END;
IENot: IncrementalEvalProc =
BEGIN
ic.value ← ic.sensitiveTo ← NOT NARROW[ic.data, IncrementalCondition].value;
END;
PostOnCell: PUBLIC PROC [cell: Cell, condition: Condition] =
BEGIN
RoseEvents.AddWatcher[$EndOfClockCycle, [CheckCondition, condition], cell];
END;
UnPostOnCell: PUBLIC PROC [cell: Cell, condition: Condition] =
BEGIN
RoseEvents.RemoveWatcher[$EndOfClockCycle, [CheckCondition, condition], cell];
END;
CheckCondition: RoseTypes.NotifyProc =
BEGIN
cond: Condition ← NARROW[watcherData];
ans: BOOLEAN ← EvalCondition[cond];
IF ans THEN SIGNAL RoseTypes.Stop["Strobed Breakpoint hit", cond];
END;
EvalCondition: PROC [cond: Condition] RETURNS [ans: BOOLEAN] =
BEGIN
SELECT cond.info FROM
test => BEGIN
nt: NodeTest ← NARROW[cond.leftChild];
ans ← nt.testProc[testData: nt.testData, nodeType: nt.node.type, where: nt.node.visible.SocketToWP[]];
END;
Trees.and => BEGIN
FOR c: Condition ← NARROW[cond.leftChild], c.rightSibling WHILE c # NIL DO
IF NOT EvalCondition[c] THEN RETURN [FALSE];
ENDLOOP;
RETURN [TRUE];
END;
Trees.or => BEGIN
FOR c: Condition ← NARROW[cond.leftChild], c.rightSibling WHILE c # NIL DO
IF EvalCondition[c] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
END;
Trees.not => ans ← NOT EvalCondition[NARROW[cond.leftChild]];
ENDCASE => ERROR;
END;
LongNodeName: PROC [nodeName: ROPE, cell: Cell] RETURNS [l: ROPE] =
BEGIN
l ← NIL;
WHILE cell.parent # NIL DO
l ← IF l = NIL THEN cell.name ELSE cell.name.Cat[".", l];
cell ← cell.parent;
ENDLOOP;
l ← IF l = NIL THEN nodeName ELSE l.Cat[".", nodeName];
END;
WriteTest: Trees.WriteProc =
BEGIN
nt: NodeTest ← NARROW[leftChild];
to.PutF["%g=%g",
IO.rope[LongNodeName[nt.nodeName, nt.cell]],
IO.rope[nt.nodeFormat.FormatTest[
nt.node.type,
nt.nodeFormat,
nt.testProc,
nt.testData]]];
END;
Setup: PROC =
BEGIN OPEN Trees.stuff;
test ← Trees.NewNodeType[LIST[ DA[$arity, $Leafary], DP[$write, WriteTest] ]];
END;
Setup[];
END.