DIRECTORY Basics, PartialOrders, RedBlackTree; PartialOrdersImpl: CEDAR PROGRAM IMPORTS RedBlackTree EXPORTS PartialOrders = BEGIN OPEN PartialOrders; PartialOrder: TYPE = REF PartialOrderPrivate; PartialOrderPrivate: PUBLIC TYPE = RECORD [ extreme: ARRAY Direction OF Vertex ]; VertexList: TYPE = LIST OF Vertex; Vertex: TYPE = REF VertexPrivate; VertexPrivate: PUBLIC TYPE = RECORD [ elt: Element, succs: ARRAY Direction OF VertexList _ ALL[NIL], rank: ARRAY Direction OF INT _ ALL[0], directDominator: Vertex _ NIL, directDominees: VertexList _ NIL ]; IsPartialOrder: PUBLIC PROC [ra: REF ANY] RETURNS [b: BOOL] = { b _ ISTYPE[ra, PartialOrder]}; NarrowToPartialOrder: PUBLIC PROC [ra: REF ANY] RETURNS [po: PartialOrder] = { po _ NARROW[ra]}; IsVertex: PUBLIC PROC [ra: REF ANY] RETURNS [b: BOOL] = { b _ ISTYPE[ra, Vertex]}; NarrowToVertex: PUBLIC PROC [ra: REF ANY] RETURNS [v: Vertex] = { v _ NARROW[ra]}; Create: PUBLIC PROC RETURNS [po: PartialOrder] = { v0: Vertex = NEW [VertexPrivate _ [ elt: NIL, rank: [increasing: 0, decreasing: 1] ]]; vf: Vertex = NEW [VertexPrivate _ [ elt: NIL, rank: [decreasing: 0, increasing: 1] ]]; v0.succs[increasing] _ LIST[vf]; vf.succs[decreasing] _ LIST[v0]; po _ NEW [PartialOrderPrivate _ [ extreme: [increasing: vf, decreasing: v0] ]]; }; Insert: PUBLIC PROC [po: PartialOrder, elt: Element, lesser, greater: Vertex _ NIL] RETURNS [v: Vertex] = { IF lesser = NIL THEN lesser _ po.extreme[decreasing]; IF greater = NIL THEN greater _ po.extreme[increasing]; v _ NEW [VertexPrivate _ [ elt: elt, succs: [ increasing: LIST[greater], decreasing: LIST[lesser]], rank: [ increasing: lesser.rank[increasing]+1, decreasing: greater.rank[decreasing]+1] ]]; IF lesser = po.extreme[increasing] OR greater = po.extreme[decreasing] THEN ERROR; lesser.succs[increasing] _ CONS[v, lesser.succs[increasing]]; greater.succs[decreasing] _ CONS[v, greater.succs[decreasing]]; UpdateRank[increasing, greater, v]; UpdateRank[decreasing, lesser, v]; }; UpdateRank: PROC [direction: Direction, v, prec: Vertex] = { IF v.rank[direction] <= prec.rank[direction] THEN { v.rank[direction] _ prec.rank[direction] + 1; FOR sl: VertexList _ v.succs[direction], sl.rest WHILE sl # NIL DO UpdateRank[direction, sl.first, v]; ENDLOOP; v _ v; }; prec _ prec; }; Relate: PUBLIC PROC [po: PartialOrder, lesser, greater: Vertex] = { IF lesser = po.extreme[increasing] OR greater = po.extreme[decreasing] THEN ERROR; lesser.succs[increasing] _ CONS[greater, lesser.succs[increasing]]; greater.succs[decreasing] _ CONS[lesser, greater.succs[decreasing]]; UpdateRank[increasing, greater, lesser]; UpdateRank[decreasing, lesser, greater]; }; IsSource: PUBLIC PROC [po: PartialOrder, v: Vertex, dir: Direction] RETURNS [BOOL] ~ { RETURN [v.rank[dir]=1]}; Enumerate: PUBLIC PROC [po: PartialOrder, direction: Direction, start: Vertex _ NIL, consume: Consumer] = { inOrder: RedBlackTree.Table = SELECT direction FROM increasing => RedBlackTree.Create[GetKey, IncCompare], decreasing => RedBlackTree.Create[GetKey, DecCompare], ENDCASE => ERROR; ExploreFrom: PROC [v: Vertex, insert: BOOL] = { IF v = po.extreme[direction] THEN RETURN; IF insert THEN inOrder.Insert[v, v !RedBlackTree.DuplicateKey => GOTO Old]; FOR vl: VertexList _ v.succs[direction], vl.rest WHILE vl # NIL DO ExploreFrom[vl.first, TRUE]; ENDLOOP; v _ v; EXITS Old => po _ po; }; PerVertex: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { v: Vertex = NARROW[data]; consume[v.rank[direction], v.elt, v]; }; IF start # NIL THEN ExploreFrom[start, TRUE] ELSE ExploreFrom[po.extreme[Opposite[direction]], FALSE]; inOrder.EnumerateIncreasing[PerVertex]; }; Opposite: ARRAY Direction OF Direction = [increasing: decreasing, decreasing: increasing]; GetKey: PROC [data: REF ANY] RETURNS [k: REF ANY] --RedBlackTree.GetKey-- = { k _ data; }; IncCompare: PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] = { k1: Vertex = NARROW[k]; k2: Vertex = NARROW[data]; c _ SELECT k1.rank[increasing]-k2.rank[increasing] FROM < 0 => less, = 0 => SELECT LOOPHOLE[k1, INT]-LOOPHOLE[k2, INT] FROM < 0 => less, = 0 => equal, > 0 => greater, ENDCASE => ERROR, > 0 => greater, ENDCASE => ERROR; }; DecCompare: PROC [k, data: REF ANY] RETURNS [c: Basics.Comparison] = { k1: Vertex = NARROW[k]; k2: Vertex = NARROW[data]; c _ SELECT k1.rank[decreasing]-k2.rank[decreasing] FROM < 0 => less, = 0 => SELECT LOOPHOLE[k1, INT]-LOOPHOLE[k2, INT] FROM < 0 => less, = 0 => equal, > 0 => greater, ENDCASE => ERROR, > 0 => greater, ENDCASE => ERROR; }; EnumerateNeighbors: PUBLIC PROC [po: PartialOrder, direction: Direction, vertex: Vertex _ NIL, consume: Consumer] = { nextRank: INT; IF vertex = NIL THEN vertex _ po.extreme[Opposite[direction]]; nextRank _ vertex.rank[direction] + 1; FOR sl: VertexList _ vertex.succs[direction], sl.rest WHILE sl # NIL DO next: Vertex = sl.first; IF next.rank[direction] = nextRank AND next # po.extreme[direction] THEN consume[nextRank, next.elt, next]; ENDLOOP; }; GotIt: ERROR = CODE; ComputeDirectDominance: PUBLIC PROC [po: PartialOrder] = { ClearDominance: PROC [rank: INT, elt: Element, v: Vertex] = { v.directDominator _ NIL; v.directDominees _ NIL; }; SetDominance: PROC [rank: INT, elt: Element, v: Vertex] = { ENABLE GotIt => GOTO Dun; y: Vertex = v; yRank: INT = rank; curRank: INT _ rank; seenHere: INT _ 2; x: Vertex _ NIL; SeeGreater: PROC [rank: INT, elt: Element, v: Vertex] = { IF rank = curRank THEN seenHere _ seenHere + 1 ELSE { IF seenHere = 1 THEN { y.directDominator _ x; x.directDominees _ CONS[y, x.directDominees]; GotIt; }; seenHere _ 1; curRank _ rank; }; x _ v; }; Enumerate[po, increasing, v, SeeGreater]; SeeGreater[curRank+1, po.extreme[increasing].elt, po.extreme[increasing]]; SeeGreater[curRank+1, NIL, NIL]; ERROR; EXITS Dun => v _ v; }; Enumerate[po, increasing, NIL, ClearDominance]; ClearDominance[0, NIL, po.extreme[increasing]]; ClearDominance[0, NIL, po.extreme[decreasing]]; Enumerate[po, increasing, NIL, SetDominance]; }; EnumerateDirectDominees: PUBLIC PROC [po: PartialOrder, vertex: Vertex _ NIL, consume: Consumer] = { IF vertex = NIL THEN vertex _ po.extreme[increasing]; FOR vl: VertexList _ vertex.directDominees, vl.rest WHILE vl # NIL DO v: Vertex = vl.first; consume[v.rank[decreasing], v.elt, v]; ENDLOOP; po _ po; }; END. ║PartialOrdersImpl.Mesa Spreitzer, December 7, 1985 5:17:55 pm PST Last tweaked by Mike Spreitzer on July 19, 1988 3:46:49 pm PDT Length of longest path in given direction to here. Э╩ЩЦ "cedar" styleШcodeЩKЩ*KЩ>ЧKШKЪ╧k Ь%Ш.KШЪ╨bxЬЭЬЭШ KЪЭЬ ШKЪЭЬШЧKШKЪЬЭЬЭЬШKШKЪЬЭЬЭЬШ-ЪЬЭЬЭЬЭЬШ+KЪЬ ЭЬЭЬШ"KЪЬШЧKШKЪЬЭЬЭЬЭЬШ"KЪЬЭЬЭЬШ!ЪЬЭЬЭЬЭЬШ%KШ KЪ ЬЭЬЭЬЭЬЭЬШ0Ъ ЬЭЬЭЬЭЬЭЬШ&KЩ2ЧKЪЬЭЬШKЪЬЭШ KШЧKШЪ╧nЬЭЬЭЬЭЬЭЬЭЬЭЬШ?KЪЬЭЬШЧKШЪЯЬЭЬЭЬЭЬЭЬЭЬШNKЪЬЭЬШЧKШЪЯЬЭЬЭЬЭЬЭЬЭЬЭЬШ9KЪЬЭЬШЧKШЪЯЬЭЬЭЬЭЬЭЬЭЬШAKЪЬЭЬШЧKШKШЪЯЬЭЬЭЬЭЬШ2ЪЬ ЭЬШ#KЪЬЭЬШ KШ$KШЧЪЬ ЭЬШ#KЪЬЭЬШ KШ$KШЧKЪЬЭЬШ KЪЬЭЬШ ЪЬЭЬШ!KШ)KЪЬШЧKШЧKШЪ ЯЬЭЬЭЬ<ЭЬЭЬШkKЪЭЬ ЭЬЭЬ!Ш5KЪЭЬЭЬЭЬ"Ш7ЪЬЭЬШKШ ШKЪЬЭЬ ШKЪЬЭЬ ШЧЪЬШKЪЬ&Ш&KЪЬ'Ш'ЧKШЧKЪЭЬ!ЭЬ"ЭЬЭЬШRKЪЬЭЬШ=KЪЬЭЬШ?KЪЬ#Ш#KШ"KШЧKШЪЯ ЬЭЬ,Ш<ЪЭЬ+ЭЬШ3KШ-ЪЭЬ.ЭЬЭЬЭШBKШ#KЪЭЬШЧKШKШЧKШKШЧKШЪЯЬЭЬЭЬ0ШCKЪЭЬ!ЭЬ"ЭЬЭЬШRKЪЬЭЬ$ШCKЪЬЭЬ$ШDKЪЬ(Ш(KЪЬ(Ш(KШЧKШЪ ЯЬЭЬЭЬ/ЭЬЭЬШVKЪЭЬШЧKШЪЯ ЬЭЬЭЬ:ЭЬШkЪЬЭЬЭШ3KШ6KШ6KЪЭЬЭЬШЧЪЯЬЭЬЭЬШ/KЪЭЬЭЬЭЬШ)KЪЭЬЭЬ3ЭЬШKЪЭЬ.ЭЬЭЬЭШBKЪЬЭЬШKЪЭЬШЧKШЪЭШKШЧKШЧЪЯ ЬЭЬЭЬЭЬЭЬЭЬЭЬ╧cЬШZKЪЬЭЬШKШ%KШЧЪЭЬ ЭШKЪЭЬЭЬШKЪЭЬ.ЭЬШ9ЧKЪЬ'Ш'KШЧKШKЪЬ ЭЬЭЬ>ШZKШЪЯЬЭЬЭЬЭЬЭЬЭЬЭЬаЬШMKШ KШЧKШЪ Я ЬЭЬЭЬЭЬЭЬШFKЪЬ ЭЬШKЪЬ ЭЬШЪЬЭЬ)ЭШ7KШЪЬЭЬЭЬЭЬЭЬЭЬЭШ6KШKШ KШKЪЭЬЭЬШЧKШKЪЭЬЭЬШЧKШЧKШЪ Я ЬЭЬЭЬЭЬЭЬШFKЪЬ ЭЬШKЪЬ ЭЬШЪЬЭЬ)ЭШ7KШЪЬЭЬЭЬЭЬЭЬЭЬЭШ6KШKШ KШKЪЭЬЭЬШЧKШKЪЭЬЭЬШЧKШЧKШЪЯЬЭЬЭЬ;ЭЬШuKЪЬ ЭЬШKЪЭЬ ЭЬЭЬ*Ш>KШ&ЪЭЬ3ЭЬЭЬЭШGKШKЪЭЬ!ЭЬЭЬ#ШkKЪЭЬШЧKШЧKШKЪЬЭЬЭЬШKШЪЯЬЭЬЭЬШ:ЪЯЬЭЬЭЬШ=KЪЬЭЬШKЪЬЭЬШKШЧЪЯЬЭЬЭЬШ;KЪЭЬ ЭЬШKШKЪЬЭЬШKЪЬ ЭЬШKЪЬ ЭЬШKЪЬЭЬШЪЯ ЬЭЬЭЬШ9ЪЭЬШKЪЭЬШЪЭЬШЪЭЬЭЬШKЪЬШKЪЬЭЬШ-KШKЪЬШЧKШ KШKЪЬШЧЧKШKШЧKЪЬ)Ш)KЪЬJШJKЪЬЭЬЭЬШ KЪЭЬШKЪЭЬШKШЧKЪЬЭЬШ/KЪЬЭЬШ/KЪЬЭЬШ/KЪЬЭЬШ-KШЧKШЪЯЬЭЬЭЬ%ЭЬШdKЪЭЬ ЭЬЭЬ!Ш5ЪЭЬ1ЭЬЭЬЭШEKШKШ&KЪЭЬШЧKШKШЧKШKЪЭЬШЧЕЧо"