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; PROCEDUREBe (vbt: VBT.T; t: T) = BEGIN t.vbt := vbt; VBT.PutProp (vbt, NEW (Prop, t := t)) END Be; PROCEDUREResolve (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; PROCEDUREBeChild (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; PROCEDUREUnChild (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; PROCEDUREIsChild (vbt: VBT.T; ch: VBT.T): BOOLEAN = BEGIN RETURN RefList.Member(Parents(ch), vbt) END IsChild; PROCEDUREParents (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; PROCEDUREMoveDefault (t: Split; pred, ch: VBT.T) = <* FATAL MultiSplit.NotAChild *> BEGIN MultiSplit.Delete (t.vbt, ch); MultiSplit.Insert (t.vbt, pred, ch); END MoveDefault; PROCEDURESuccDefault (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; PROCEDUREHasChild (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.