<> <> <> <<>> DIRECTORY Rope, DrotBool; DrotBoolTree: CEDAR MONITOR IMPORTS Rope EXPORTS DrotBool ~ BEGIN OPEN DrotBool; <> <<--Dags have two types of ordering here. The first is the conventional one where each node may have children and parents. However, to make the data structure more manageable the nodes are kept on a circularly linked list and in this sense have a 'linear order.' To visit each node for example one may percolate around the nodes in a depth first search (after finding the sources, of course) or one may just go from one to the next in linear order.>> <<>> PlaceAtEnd: PUBLIC PROC [tree: Dag, vertex: Node] ~ { <> IF vertex^.next # NIL THEN --No action in an empty tree IF tree^.csucs = vertex --If vertex is the first element THEN { vertex^.prev^.next _ vertex; tree^.csucs _ vertex^.next; vertex^.next _ NIL } ELSE { tree^.csucs^.prev^.next _ vertex; vertex^.next^.prev _ vertex^.prev; vertex^.prev^.next _ vertex^.next; vertex^.prev _ tree^.csucs^.prev; tree^.csucs^.prev _ vertex; vertex^.next _ NIL }; }; PlaceAtBeg: PUBLIC PROC [tree: Dag, vertex: Node] ~ { <> IF vertex # tree^.csucs THEN { IF vertex^.next = NIL --If vertex is the last element THEN { vertex^.prev^.next _ NIL } ELSE { vertex^.prev^.next _ vertex^.next; vertex^.next^.prev _ vertex^.prev; vertex^.prev _ tree^.csucs^.prev; tree^.csucs^.prev _ vertex }; vertex^.next _ tree^.csucs; tree^.csucs _ vertex} }; PrimitivesToEnd: PUBLIC PROC [tree: Dag] ~ { <> IF tree # NIL AND tree^.csucs # NIL THEN { --If the tree is not NIL nonPrimEncountered : BOOL _ FALSE; vertex : Node _ tree^.csucs^.prev; WHILE vertex # tree^.csucs DO IF vertex^.type = prim AND nonPrimEncountered THEN { temp: Node _ vertex^.prev; --So we don't lose our place PlaceAtEnd[tree, vertex]; vertex _ temp} ELSE { nonPrimEncountered _ (vertex^.type # prim); vertex _ vertex^.prev} ENDLOOP; <> IF vertex^.type = prim AND nonPrimEncountered THEN PlaceAtEnd[tree, vertex]} }; OrphansToFront: PUBLIC PROC [tree: Dag] ~ { <> IF tree # NIL AND tree^.csucs # NIL THEN { nonOrphanEncountered : BOOL _ FALSE; iter: Node _ tree^.csucs; WHILE iter # NIL DO IF iter^.parnum = 0 AND nonOrphanEncountered THEN { temp: Node _ iter^.next; --So we don't lose our place PlaceAtBeg[tree, iter]; iter _ temp } ELSE { nonOrphanEncountered _ (iter^.parnum > 0); iter _ iter^.next} ENDLOOP}; }; PlaceBefore: PUBLIC PROC [tree: Dag, before, after: Node] RETURNS[Node] ~ { <> IF after = NIL THEN PlaceAtEnd[tree, before] ELSE IF before # after AND (before^.next # after) THEN <> IF after = tree^.csucs --if after is first in the tree THEN { tree^.csucs _ before; --then before becomes the new first element IF before^.next = NIL --if before was at the end THEN { before^.next _ after; before^.prev^.next _ NIL } ELSE { before^.prev^.next _ before^.next; before^.next^.prev _ before^.prev; before^.prev _ after^.prev; before^.next _ after; after^.prev _ before }; } ELSE { IF before = tree^.csucs --if before was at the front of the tree THEN tree^.csucs _ before^.next ELSE before^.prev^.next _ before^.next; IF before^.next = NIL --if before was at the end of the tree THEN tree^.csucs^.prev _ before^.prev ELSE before^.next^.prev _ before^.prev; before^.next _ after; before^.prev _ after^.prev; after^.prev^.next _ before; after^.prev _ before }; RETURN[before^.next] }; PlaceAfter: PUBLIC PROC[tree: Dag, before, after: Node] RETURNS[Node] ~ { <> IF before = NIL THEN PlaceAtBeg[tree, after] ELSE IF before # after AND (before^.next # after) THEN IF before^.next = NIL --If before is at the end of the tree THEN { before^.next _ after; IF after = tree^.csucs --If after is first in the tree THEN { tree^.csucs _ after^.next; after^.next _ NIL} ELSE { after^.prev^.next _ after^.next; after^.next^.prev _ after^.prev; tree^.csucs^.prev _ after; after^.next _ NIL; after^.prev _ before}} ELSE { IF after^.next = NIL --If after is at the end of the tree THEN tree^.csucs^.prev _ after^.prev ELSE after^.next^.prev _ after^.prev; IF after = tree^.csucs --If after is at the head of the tree THEN tree^.csucs _ after^.next ELSE after^.prev^.next _ after^.next; after^.prev _ before; after^.next _ before^.next; before^.next^.prev _ after; before^.next _ after}; IF after = tree^.csucs THEN RETURN[NIL] ELSE RETURN[after^.prev]; }; OrderNodesByPrims: PUBLIC PROC [tree: Dag] ~ { <> IF tree^.csucs # NIL THEN { PrimitivesToEnd[tree]; ClearScratch[tree]; <> IF (tree^.csucs^.type # prim) AND (tree^.csucs^.prev^.type = prim) THEN { rear: Node _ tree^.csucs^.prev; front: Node _ rear; WHILE front^.type = prim DO front _ front^.prev; ENDLOOP; <> front _ front^.next; WHILE front # tree^.csucs DO --Main routine pariter: Kidptr _ rear^.parlist; WHILE pariter # NIL DO --For each parent pariter^.child^.scratch _ pariter^.child^.scratch + 1; IF pariter^.child^.scratch = pariter^.child^.kidnum THEN { KidptrToEnd[pariter^.parlink, pariter^.child]; <> [] _ PlaceBefore[tree, pariter^.child, front]; front _ pariter^.child}; pariter _ pariter^.next; ENDLOOP; rear _ rear^.prev; ENDLOOP}} }; OrderNodesByOrphans: PUBLIC PROC [tree: Dag] ~ { <> IF tree^.csucs # NIL THEN { OrphansToFront[tree]; ClearScratch[tree]; <> IF (tree^.csucs^.parnum = 0) AND (tree^.csucs^.prev^.parnum # 0) THEN { front: Node _ tree^.csucs; rear: Node _ front; WHILE rear^.parnum = 0 DO rear _ rear^.next; ENDLOOP; <> WHILE rear # NIL DO kiditer: Kidptr _ front^.kidlist; WHILE kiditer # NIL DO kiditer^.child^.scratch _ kiditer^.child^.scratch + 1; IF kiditer^.child^.scratch = kiditer^.child^.parnum THEN rear _ PlaceBefore[tree, kiditer^.child, rear]; kiditer _ kiditer^.next; ENDLOOP; front _ front^.next; ENDLOOP}} }; <> RemoveNode: PUBLIC PROC [tree: Dag, vertex: Node] ~ { <> kiter: Kidptr _ vertex^.kidlist; piter: Kidptr _ vertex^.parlist; WHILE kiter # NIL DO --Gets rid of the links with the Children kiter _ KillCLink[kiter]; ENDLOOP; WHILE piter # NIL DO --Gets rid of the links with the Parents piter _ KillPLink[piter]; ENDLOOP; IF vertex^.brother # NIL THEN vertex^.brother^.brother _ NIL; <> IF vertex^.next = NIL THEN tree^.csucs^.prev _ vertex^.prev ELSE vertex^.next^.prev _ vertex^.prev; IF vertex = tree^.csucs THEN tree^.csucs _ vertex^.next ELSE vertex^.prev^.next _ vertex^.next; <> IF vertex^.number < tree^.size THEN { iter: Node _ tree^.csucs; WHILE iter^.number # tree^.size DO iter _ iter^.next ENDLOOP; iter^.number _ vertex^.number}; tree^.size _ tree^.size - 1 }; MakeNewNodeA: PUBLIC PROC [tree: Dag, vertex: Node, type: Vtype _ prim, inname: ROPE _ NIL, varname: ROPE _ NIL, outname: LIST OF ROPE _ NIL, output: BOOL _ FALSE] RETURNS[temp: Node] ~ { <> temp _ NEW[Noderec _ [type: type, inname: inname, varname: varname, outname: outname, output: output, number: tree^.size + 1]]; IF tree^.csucs = NIL THEN { --If the tree was empty temp^.prev _ temp; tree^.csucs _ temp} ELSE IF vertex = NIL THEN { --If the new node is to be first in the tree temp^.prev _ tree^.csucs^.prev; temp^.next _ tree^.csucs; temp^.next^.prev _ temp; tree^.csucs _ temp} ELSE { temp^.prev _ vertex; temp^.next _ vertex^.next; IF vertex^.next = NIL THEN tree^.csucs^.prev _ temp ELSE vertex^.next^.prev _ temp; vertex^.next _ temp}; tree^.size _ tree^.size + 1 }; MakeNewNodeB: PUBLIC PROC [tree: Dag, vertex: Node, type: Vtype _ prim, inname: ROPE _ NIL, varname: ROPE _ NIL, outname: LIST OF ROPE _ NIL, output: BOOL _ FALSE] RETURNS[temp: Node] ~ { <> temp _ NEW[Noderec _ [type: type, inname: inname, varname: varname, outname: outname, output: output, number: tree^.size + 1]]; IF tree^.csucs = NIL THEN { --If the tree is empty temp^.prev _ temp; tree^.csucs _ temp} ELSE IF vertex = NIL THEN { --If the new node is to be last in the tree (in linear order) temp^.prev _ tree^.csucs^.prev; tree^.csucs^.prev _ temp; temp^.prev^.next _ temp} ELSE { temp^.next _ vertex; temp^.prev _ vertex^.prev; IF vertex = tree^.csucs THEN tree^.csucs _ temp ELSE vertex^.prev^.next _ temp; vertex^.prev _ temp}; tree^.size _ tree^.size + 1 }; MakeBrother: PUBLIC PROC [tree: Dag, vertex: Node] ~ { <> IF vertex^.brother = NIL THEN { [] _ MakeNewNodeA[tree, vertex, NegNodeType[vertex^.type], NegateVarName[vertex^.inname]]; vertex^.brother _ vertex^.next; vertex^.brother^.brother _ vertex} }; KillCLink: PUBLIC PROC [link: Kidptr] RETURNS [Kidptr] ~ { <> kid: Node _ link^.child; --This is the child plink: Kidptr _ link^.parlink; --This is the link from the child to the parent par: Node _ plink^.child; --The parent par^.kidnum _ par^.kidnum - 1; kid^.parnum _ kid^.parnum - 1; IF link^.next = NIL THEN par^.kidlist^.prev _ link^.prev ELSE link^.next^.prev _ link^.prev; IF plink^.next = NIL THEN kid^.parlist^.prev _ plink^.prev ELSE plink^.next^.prev _ plink^.prev; IF link = par^.kidlist THEN par^.kidlist _ link^.next ELSE link^.prev^.next _ link^.next; IF plink = kid^.parlist THEN kid^.parlist _ plink^.next ELSE plink^.prev^.next _ plink^.next; RETURN[link^.next] }; KillPLink: PUBLIC PROC [plink: Kidptr] RETURNS [Kidptr] ~ { <> [] _ KillCLink[plink^.parlink]; RETURN [plink^.next] }; MakeLink: PUBLIC PROC [par,gyerek: Node] ~ { <> temp: Kidptr; par^.kidlist _ NEW[Kidrec _ [child: gyerek, next: par^.kidlist]]; gyerek^.parlist _ NEW[Kidrec _ [child: par, next: gyerek^.parlist, parlink: par^.kidlist]]; par^.kidlist^.parlink _ gyerek^.parlist; temp _ par^.kidlist; IF temp^.next = NIL THEN temp^.prev _ temp ELSE { temp^.prev _ temp^.next^.prev; temp^.next^.prev _ temp}; temp _ gyerek^.parlist; IF temp^.next = NIL THEN temp^.prev _ temp ELSE { temp^.prev _ temp^.next^.prev; temp^.next^.prev _ temp}; par^.kidnum _ par^.kidnum + 1; gyerek^.parnum _ gyerek^.parnum + 1 }; MakeLinkE: PUBLIC PROC [szulo, gyerek: Node] ~ { <> tempk: Kidptr _ NEW[Kidrec _ [child: gyerek]]; tempp: Kidptr _ NEW[Kidrec _ [child: szulo, parlink: tempk]]; tempk^.parlink _ tempp; IF szulo^.kidlist = NIL THEN szulo^.kidlist _ tempk ELSE { szulo^.kidlist^.prev^.next _ tempk; tempk^.prev _ szulo^.kidlist^.prev}; szulo^.kidlist^.prev _ tempk; IF gyerek^.parlist = NIL THEN gyerek^.parlist _ tempp ELSE { gyerek^.parlist^.prev^.next _ tempp; tempp^.prev _ gyerek^.parlist^.prev}; gyerek^.parlist^.prev _ tempp; szulo^.kidnum _ szulo^.kidnum + 1; gyerek^.parnum _ gyerek^.parnum + 1 }; RemoveLink: PUBLIC PROC [szulo, gyerek: Node] ~ { <> temp: Kidptr _ ConnectionBetween[szulo,gyerek]; WHILE temp # NIL DO [] _ KillCLink[temp]; temp _ ConnectionBetween[szulo,gyerek]; ENDLOOP; }; <> EstablishLevels: PUBLIC PROC [tree: Dag] ~ { <> ResetLevels[tree]; FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO IF iter^.parnum = 0 THEN REstablishLevels[iter,1]; ENDLOOP; }; ResetLevels: PROC [tree: Dag] ~ { <> FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO iter^.level _ 0; ENDLOOP; }; REstablishLevels: PROC [iter: Node, levelnum: INT] ~ { <> IF iter # NIL AND levelnum > iter^.level THEN { IF iter^.kidnum = 1 THEN REstablishLevels[iter^.kidlist^.child, levelnum + 1] ELSE FOR kiditer: Kidptr _ iter^.kidlist, kiditer^.next UNTIL kiditer = NIL DO REstablishLevels[kiditer^.child, levelnum + CLogarythm[2,iter^.kidnum]]; ENDLOOP; iter^.level _ levelnum} }; CLogarythm: PUBLIC PROC [base, num: INT] RETURNS [INT] ~ { <> IF num = 1 THEN RETURN[0] ELSE RETURN[1 + CLogarythm[base, (num + base -1)/base]] }; ClearScratch: PUBLIC PROC [tree: Dag] ~ { <> FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO iter^.scratch _ 0; ENDLOOP; }; <> NegNodeType: PUBLIC PROC [intype: Vtype] RETURNS [Vtype] ~ { <> SELECT intype FROM nand => RETURN[and]; and => RETURN[nand]; or => RETURN[nor]; nor => RETURN[or]; not => RETURN[buf]; buf => RETURN[not]; ENDCASE => RETURN[prim]; --Prims are not gates }; NegateVarName: PUBLIC PROC [name: ROPE] RETURNS [ROPE] ~ { <> IF Rope.IsEmpty[name] THEN RETURN[NIL] ELSE IF Rope.Fetch[name,0] = '~ THEN RETURN[Rope.Substr[name,1,Rope.Length[name] - 1]] ELSE RETURN[Rope.Concat["~", name]]; }; MergeListOfRopes: PUBLIC PROC [lista, listb: LIST OF ROPE] RETURNS [LIST OF ROPE] ~ { <> IF listb = NIL THEN RETURN[lista] ELSE RETURN[MergeListOfRopes[CONS[listb.first, lista], listb.rest]] }; NotAbove: PUBLIC PROC [pariter: Kidptr] RETURNS [Node] ~ { <> IF pariter = NIL THEN RETURN[NIL] ELSE IF pariter^.child^.type = not THEN RETURN[pariter^.child] ELSE RETURN[NotAbove[pariter^.next]] }; NegativeOf: PUBLIC PROC [vertex: Node] RETURNS [negVertex: Node _ NIL] ~ { <> IF vertex # NIL THEN IF vertex^.brother # NIL THEN RETURN[vertex^.brother] ELSE IF vertex^.type = not THEN RETURN[vertex^.kidlist^.child] ELSE RETURN[NotAbove[vertex^.parlist]]; }; ConnectionBetween: PUBLIC PROC [szulo, gyerek: Node] RETURNS [link: Kidptr _ NIL] ~ { <> FOR iter: Kidptr _ szulo^.kidlist, iter^.next UNTIL iter = NIL DO IF iter^.child = gyerek THEN RETURN[iter]; ENDLOOP; }; FindExpressionByName: PUBLIC PROC [tree: Dag, name: ROPE] RETURNS [vertex: Node _ NIL] ~ { <> FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO IF Rope.Equal[iter^.varname,name] THEN RETURN[iter]; FOR nameiter: LIST OF ROPE _ iter^.outname, nameiter.rest UNTIL nameiter = NIL DO IF Rope.Equal[nameiter.first,name] THEN RETURN[iter]; ENDLOOP; ENDLOOP; }; FindInputByName: PUBLIC PROC [tree: Dag, name: ROPE] RETURNS [vertex: Node _ NIL] ~ { <> FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO IF iter^.type = prim AND Rope.Equal[iter^.inname,name] THEN RETURN[iter]; ENDLOOP; }; FindNodeByName: PUBLIC PROC [tree: Dag, name: ROPE] RETURNS [vertex: Node] ~ { <> vertex _ FindInputByName[tree, name]; IF vertex # NIL THEN RETURN[vertex] ELSE RETURN[FindExpressionByName[tree, name]] }; <> ForwardSimilar: PUBLIC PROC [nodea, nodeb: Node] RETURNS [a: BOOL _ FALSE] ~ { <> IF nodea^.kidnum = nodeb^.kidnum THEN RETURN[KidlistEqual[nodea^.kidlist, nodeb^.kidlist]] }; KidlistEqual: PROC [kidlista, kidlistb: Kidptr] RETURNS [a: BOOL] ~ { <> iterb: Kidptr _ kidlistb; FOR itera: Kidptr _ kidlista, itera^.next DO IF itera = NIL THEN RETURN[TRUE] ELSE IF itera^.child # iterb^.child THEN RETURN[FALSE] ELSE iterb _ iterb^.next ENDLOOP; }; KidptrToEnd: PUBLIC PROC [kid: Kidptr, par: Node] ~ { <> IF kid^.next # NIL THEN IF par^.kidlist = kid THEN { kid^.prev^.next _ kid; par^.kidlist _ kid^.next; kid^.next _ NIL } ELSE { par^.kidlist^.prev^.next _ kid; kid^.next^.prev _ kid^.prev; kid^.prev^.next _ kid^.next; kid^.prev _ par^.kidlist^.prev; par^.kidlist^.prev _ kid; kid^.next _ NIL }; }; Negate: PUBLIC PROC [tree: Dag, vertex: Node] RETURNS [csucs: Node] ~ { <> IF vertex^.brother # NIL THEN RETURN[vertex^.brother] ELSE IF vertex^.type = not THEN IF (vertex^.parnum > 0) OR vertex^.output THEN RETURN[vertex^.kidlist^.child] ELSE { temp: Node _ vertex^.kidlist^.child; RemoveNode[tree, vertex]; RETURN[temp]} ELSE { IF NotAbove[vertex^.parlist] # NIL THEN RETURN[NotAbove[vertex^.parlist]]; IF vertex^.type # prim AND vertex^.parnum = 0 AND NOT vertex^.output THEN { vertex^.type _ NegNodeType[vertex^.type]; RETURN[vertex]}; MakeLink[MakeNewNodeB[tree, vertex, not], vertex]; RETURN[vertex^.prev]} }; IntersectionSize: PUBLIC PROC [nagy, kicsi: Node] RETURNS [size: INT _ 0] ~ { <> FOR iter: Kidptr _ kicsi^.kidlist, iter^.next UNTIL iter = NIL DO iter^.child^.scratch _ 0; ENDLOOP; FOR iter: Kidptr _ nagy^.kidlist, iter^.next UNTIL iter = NIL DO iter^.child^.scratch _ 1; ENDLOOP; FOR iter: Kidptr _ kicsi^.kidlist, iter^.next UNTIL iter = NIL DO size _ size + iter^.child^.scratch; iter^.child^.scratch _ iter^.child^.scratch + 1; ENDLOOP; }; NegateConnection: PUBLIC PROC [tree: Dag, link: Kidptr] ~ { <> ide: Node _ link^.child; innen: Node _ link^.parlink^.child; IF ide^.type = not THEN { MakeLink[innen, ide^.kidlist^.child]; [] _ KillCLink[link]; IF ide^.parnum = 0 AND NOT ide^.output THEN RemoveNode[tree, ide]} ELSE IF ide^.brother # NIL THEN { MakeLink[innen, ide^.brother]; [] _ KillCLink [link]} ELSE IF NotAbove[ide^.parlist] # NIL THEN { MakeLink[innen, NotAbove[ide^.parlist]]; [] _ KillCLink [link]} ELSE IF ide^.parnum > 1 OR ide^.type = prim OR ide^.output THEN { MakeLink[MakeNewNodeB[tree, ide, not, NegateVarName[ide^.inname]], ide]; MakeLink[innen, ide^.prev]; [] _ KillCLink[link]} ELSE ide^.type _ NegNodeType[ide^.type] }; KillHangingNodes: PUBLIC PROC [tree: Dag, primsToo: BOOL] ~ { <> ClearScratch[tree]; FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO IF iter^.output THEN MarkThisSubtree[iter]; ENDLOOP; FOR iter: Node _ tree^.csucs, iter^.next UNTIL iter = NIL DO IF (primsToo OR iter^.type # prim) AND iter^.scratch # 1 THEN RemoveNode[tree, iter]; ENDLOOP; }; MarkThisSubtree: PROC [vertex: Node] ~ { <> IF vertex^.scratch # 1 THEN { vertex^.scratch _ 1; SELECT vertex^.type FROM prim => NULL; not, buf => MarkThisSubtree[vertex^.kidlist^.child]; ENDCASE => FOR kiditer: Kidptr _ vertex^.kidlist, kiditer^.next UNTIL kiditer = NIL DO MarkThisSubtree[kiditer^.child]; ENDLOOP}; }; END.