RoseConditionsImpl.Mesa
Last Edited by: Spreitzer, October 15, 1984 11:04:01 pm PDT
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;
Simulation: TYPE = RoseTypes.Simulation;
IncrementalCondition: TYPE = REF IncrementalConditionRep;
IncrementalConditionRep:
PUBLIC
TYPE =
RECORD [
eval: IncrementalEvalProc ← NIL,
data: REF ANY ← NIL,
parent: IncrementalCondition ← NIL,
sibling: IncrementalCondition ← NIL,
value, sensitiveTo: BOOLEAN ← FALSE];
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] ]];
ic ← ic;
ic ← ic;
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: BOOLEAN ← TRUE;
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];
ic ← ic;
END;
NotifyIncremental: RoseEvents.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);
RETURN;
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);
RETURN;
END;
ENDLOOP;
ic.sensitiveTo ← NOT (ic.value ← FALSE);
END;
IENot: IncrementalEvalProc =
BEGIN
ic.value ← ic.sensitiveTo ← NOT NARROW[ic.data, IncrementalCondition].value;
END;
PostOnSettle:
PUBLIC
PROC [sim: Simulation, condition: Condition] =
BEGIN
RoseEvents.AddWatcher[$Settled, [CheckCondition, condition], sim];
END;
UnPostOnSettle:
PUBLIC
PROC [sim: Simulation, condition: Condition] =
BEGIN
RoseEvents.RemoveWatcher[$Settled, [CheckCondition, condition], sim];
END;
CheckCondition: RoseEvents.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.