Copyright (C) 1994, Digital Equipment Corp.
MODULE; IMPORT RefList, MultiSplit, VBT; IMPORT Split AS TrestleSplit; EXCEPTION FatalError; <* FATAL FatalError *> REVEAL Split = T BRANDED OBJECT OVERRIDES MultiClass
replace := NIL; insert := NIL;
move := MoveDefault;
succ := SuccDefault;
pred := PredDefault;
nth := NthDefault;
index := IndexDefault;
END;
TYPE
Prop = REF RECORD t: T END;
ChProp = REF RECORD parents: RefList.T (* of VBT.T *) END;
PROCEDURE Be (vbt: VBT.T; t: T) =
BEGIN
t.vbt := vbt;
VBT.PutProp (vbt, NEW (Prop, t := t))
END Be;
PROCEDURE Resolve (vbt: VBT.T): T =
VAR prop: Prop := VBT.GetProp (vbt, TYPECODE (Prop));
BEGIN
IF prop = NIL THEN RETURN NIL ELSE RETURN prop.t END
END Resolve;
PROCEDURE BeChild (vbt: VBT.T; ch: VBT.T) =
VAR chProp: ChProp := VBT.GetProp (ch, TYPECODE (ChProp));
BEGIN
IF chProp = NIL THEN
chProp := NEW (ChProp);
VBT.PutProp (ch, chProp);
END;
chProp.parents := RefList.Cons (vbt, chProp.parents);
END BeChild;
PROCEDURE UnChild (vbt: VBT.T; ch: VBT.T) =
VAR chProp: ChProp := VBT.GetProp (ch, TYPECODE (ChProp));
PROCEDURE remove (VAR list: RefList.T) =
BEGIN
IF list = NIL THEN (* skip *)
ELSIF list.head = vbt THEN
list := list.tail
ELSE
remove (list.tail)
END
END remove;
BEGIN
remove (chProp.parents)
END UnChild;
PROCEDURE IsChild (vbt: VBT.T; ch: VBT.T): BOOLEAN =
BEGIN
RETURN RefList.Member(Parents(ch), vbt)
END IsChild;
PROCEDURE Parents (ch: VBT.T): RefList.T =
VAR chProp: ChProp := VBT.GetProp (ch, TYPECODE (ChProp));
BEGIN
IF chProp = NIL THEN RETURN NIL ELSE RETURN chProp.parents END
END Parents;
PROCEDURE MoveDefault (t: Split; pred, ch: VBT.T) =
<* FATAL MultiSplit.NotAChild *>
BEGIN
MultiSplit.Delete (t.vbt, ch);
MultiSplit.Insert (t.vbt, pred, ch);
END MoveDefault;
PROCEDURE SuccDefault (t: Split; ch: VBT.T): VBT.T =
<* FATAL TrestleSplit.NotAChild *>
VAR chP, oldP, p: VBT.T;
BEGIN
chP := ch;
IF chP = NIL THEN p := t.vbt ELSE p := VBT.Parent(chP) END;
REPEAT
chP := TrestleSplit.Succ(p, chP);
WHILE (chP = NIL) AND (p # t.vbt) DO
oldP := p;
p := VBT.Parent(p);
chP := TrestleSplit.Succ(p, oldP);
END;
WHILE (chP # NIL) AND (NOT IsChild(t.vbt, chP))
AND HasChild(chP) DO
p := chP;
chP := TrestleSplit.Succ(p, NIL);
END;
UNTIL (chP = NIL) OR IsChild(t.vbt, chP);
RETURN chP
END SuccDefault;
PROCEDURE HasChild (v: VBT.T): BOOLEAN =
<* FATAL TrestleSplit.NotAChild *>
BEGIN
RETURN ISTYPE (v, VBT.Split) AND TrestleSplit.Succ(v, NIL) # NIL
WITH t = Resolve(v) DO RETURN (t # NIL) AND (t.succ(NIL) # NIL) END
END HasChild; PROCEDUREPredDefault (t: Split; ch: VBT.T): VBT.T = VAR next, res: VBT.T; BEGIN next := t.succ(NIL); WHILE next # NIL AND next # ch DO res := next; next := t.succ(res) END; IF next = ch THEN RETURN res ELSE RAISE FatalError END END PredDefault; PROCEDURENthDefault (t: Split; n: CARDINAL): VBT.T = VAR ch: VBT.T; BEGIN ch := t.succ(NIL); WHILE ch # NIL AND n # 0 DO DEC(n); ch := t.succ(ch) END; RETURN ch END NthDefault; PROCEDUREIndexDefault (t: Split; ch: VBT.T): CARDINAL = VAR res := 0; chP := t.succ (NIL); BEGIN WHILE chP # ch AND chP # NIL DO INC (res); chP := t.succ (chP) END; IF chP = ch THEN RETURN res ELSE RAISE FatalError END END IndexDefault; REVEAL Filter = Split BRANDED OBJECT OVERRIDES insert := FilterInsert; END; PROCEDUREFilterInsert (t: Filter; pred, new: VBT.T) = BEGIN t.replace(t.succ(pred), new); END FilterInsert; BEGIN END MultiClass.