GENERIC MODULE DiGraph(NodeVal, EdgeVal);

The DiGraph type is parameterized over the types of the nodes and the edges.

IMPORT RefList, Wr, Word, RefRefTbl, RefListSort, RefSeq;

IMPORT Thread;
<*FATAL Wr.Failure, Thread.Alerted*>

TYPE
  NodeValRef = REF NodeVal.T;

REVEAL
  Node = NodePublic BRANDED OBJECT
    succ, pred: RefList.T (* Of Edge *);
    misc: INTEGER;
  END;
TYPE
  NodeArr = REF ARRAY OF Node;
REVEAL
  Edge = EdgePublic BRANDED OBJECT
    nextValue : EdgeVal.T (* used in transitive closure *);
  END;

  T = TPublic BRANDED OBJECT
    nodeTbl: RefRefTbl.T; (* map from REF NodeVal's to nodes. *)
    edges: CARDINAL := 0;
    csr: ClosedSemiRing;
    undoable: BOOLEAN;
    undoSP: CARDINAL;
    undoStack: REF ARRAY OF UndoRec;

   METHODS
    nodeValToNode(nodeVal: NodeVal.T; addNodes: BOOLEAN): Node
        RAISES { NoSuchNode } := NodeValToNode;
    makeNodeArray(): NodeArr := MakeNodeArray;

   OVERRIDES
    init := TInit;
    nodeSize := NodeSize;
    edgeSize := EdgeSize;
    nodeExists := NodeExists;
    addNode := AddNode;
    deleteNode := DeleteNode;
    edgeExists := EdgeExists;
    getEdge := GetEdge;
    edgeValue := EdgeValue;
    addEdge := AddEdge;
    deleteEdge := DeleteEdge;
    setEdge := SetEdge;
    changeEdge := ChangeEdge;
    nSucc := NSucc;
    getSuccN := GetSuccN;
    getSuccIter := GetSuccIter;
    getSuccList := GetSuccList;
    nPred := NPred;
    getPredN := GetPredN;
    getPredIter := GetPredIter;
    getPredList := GetPredList;
    mapOverEdges := MapOverEdges;
    mapOverNodes := MapOverNodes;
    transitiveClose := TransitiveClose;
    addEdgeAndClose := AddEdgeAndClose;
    topSort := TopSort;
    printAsMatrix := PrintAsMatrix;
    push := Push;
    pop := Pop;
  END;

TYPE
  NodeIterImpl = NodeIter BRANDED OBJECT
    list: RefList.T;        (* Uniterated remainder of edge list. *)
    toNotFrom: BOOLEAN;  (* TRUE IF this is a 'succ' iter, FALSE if 'pred' *)
   OVERRIDES
    next := NodeIterNext;
  END (* OBJECT *);

  UndoType = { Mark, AddNode, DeleteNode, AddEdge, DeleteEdge, EdgeVal };
  UndoRec = RECORD
    type: UndoType;
    n: Node;
    e: Edge;
    ev: EdgeVal.T;
  END (* RECORD *);

PROCEDURE TInit(self: T; csr: ClosedSemiRing; undoable: BOOLEAN): T =
  BEGIN
    self.nodeTbl := NEW(RefRefTbl.Default,
                        keyHash := NodeValRefHash,
                        keyEqual := NodeValRefEqual).init();
    self.edges := 0;
    self.csr := csr;
    self.undoable := undoable;
    IF undoable THEN
      self.undoSP := 0;
      self.undoStack := NEW(REF ARRAY OF UndoRec, 100)
    END (* IF *);
    RETURN self;
  END TInit;

PROCEDURE NodeValRefHash(<*UNUSED*> t: RefRefTbl.T;
                         READONLY key: REFANY): Word.T =
  BEGIN
    RETURN NodeVal.Hash(NARROW(key, NodeValRef)^);
  END NodeValRefHash;

PROCEDURE NodeValRefEqual(<*UNUSED*> t: RefRefTbl.T;
                          READONLY key1, key2: REFANY): BOOLEAN =
  BEGIN
    RETURN NodeVal.Equal(NARROW(key1, NodeValRef)^,
                         NARROW(key2, NodeValRef)^);
  END NodeValRefEqual;

PROCEDURE NodeSize(self: T): CARDINAL =
  BEGIN
    RETURN self.nodeTbl.size()
  END NodeSize;

PROCEDURE EdgeSize(self: T): CARDINAL =
  BEGIN
    RETURN self.edges;
  END EdgeSize;

PROCEDURE NodeExists(self: T; nodeVal: NodeVal.T): BOOLEAN =
  VAR dummyVal: REFANY;
  BEGIN
    WITH nvr = NEW(NodeValRef) DO
      nvr^ := nodeVal;
      RETURN self.nodeTbl.get(nvr, dummyVal);
    END (* WITH *);
  END NodeExists;

PROCEDURE AddNode(self: T; nodeVal: NodeVal.T) RAISES { DupNode } =
  VAR n: Node;
      dummy: BOOLEAN;
  BEGIN
    IF self.nodeExists(nodeVal) THEN RAISE DupNode END;
    n := NEW(Node, value := nodeVal, succ := NIL, pred := NIL);
    WITH nvr = NEW(NodeValRef) DO
      nvr^ := nodeVal;
      dummy := self.nodeTbl.put(nvr, n);
      <*ASSERT NOT dummy*>
    END (* WITH *);
    IF self.undoable THEN PushUndo(self, UndoType.AddNode, n) END (* IF *)
  END AddNode;

PROCEDURE DeleteNode(self: T; nodeVal: NodeVal.T) RAISES { NoSuchNode } =
  VAR node: Node;
      edge: Edge;
      preds, succs: RefList.T (* Of Edge *);
      dummy: BOOLEAN;
      resultRA: REFANY;
  BEGIN
    (* This raises an exception if the node doesn't exist. *)
    node := self.nodeValToNode(nodeVal, FALSE);

    VAR nvr := NEW(NodeValRef); BEGIN
      nvr^ := nodeVal;
      dummy := self.nodeTbl.delete(nvr, resultRA);
      (* If NodeValToNode said it was there, it ought to be there. *)
      <*ASSERT dummy*>
    END (* WITH *);
    IF self.undoable THEN
      PushUndo(self, UndoType.DeleteNode, node)
    END (* IF *);

    (* Delete node from the 'succs' list of each of its predecessors. *)
    preds := node.pred;
    WHILE preds # NIL DO
      edge := preds.head;
      dummy := DeleteFromEdgeList(edge.from.succ, FALSE, node);
      <*ASSERT dummy*>
      IF self.undoable THEN
        PushUndo(self, UndoType.DeleteEdge, NIL, edge)
      END (* IF *);
      DEC(self.edges);
      preds := preds.tail
    END;
    (* ...and also from the 'preds' list of each of its successors. *)
    succs := node.succ;
    WHILE succs # NIL DO
      edge := succs.head;
      dummy := DeleteFromEdgeList(edge.to.pred, TRUE, node);
      <*ASSERT dummy*>
      IF self.undoable THEN
        PushUndo(self, UndoType.DeleteEdge, NIL, edge)
      END (* IF *);
      DEC(self.edges);
      succs := succs.tail
    END;

  END DeleteNode;

Returns a NodeArr (Array.T OF Node) of all the nodes. If 'cp' is non-NIL, uses it to sort the array.

PROCEDURE MakeNodeArray(self: T): NodeArr =
  VAR newArr := NEW(NodeArr, self.nodeTbl.size());
      iter := self.nodeTbl.iterate();
      nodeVal, node: REFANY;
      rl: RefList.T := NIL;
  BEGIN
    WHILE iter.next(nodeVal, node) DO
      rl := RefList.Cons(node, rl)
    END (* WHILE *);
    rl := RefListSort.SortD(rl, NodeCompare);
    VAR i := 0; BEGIN
      WHILE rl # NIL DO
        newArr[i] := rl.head; INC(i); rl := rl.tail
      END (* WHILE *)
    END (* BEGIN *);
    RETURN newArr
  END MakeNodeArray;

PROCEDURE NodeCompare(node1Ref, node2Ref: REFANY): [-1..1] =
  VAR
    node1, node2: Node;
  BEGIN
    node1 := NARROW(node1Ref, Node);
    node2 := NARROW(node2Ref, Node);
    RETURN NodeVal.Compare(node1.value, node2.value);
  END NodeCompare;

PROCEDURE AddEdge(self: T;
                  node1: NodeVal.T; edgeVal: EdgeVal.T; node2: NodeVal.T;
                  addNodes: BOOLEAN := FALSE)
    RAISES { NoSuchNode, DupEdge } =
  VAR
    newEdge: Edge;
    fromNode, toNode: Node;
    edgeDummy: Edge;
  BEGIN
    (* These raise NoSuchNode when necessary. *)
    fromNode := self.nodeValToNode(node1, addNodes);
    toNode := self.nodeValToNode(node2, addNodes);

    (* Check to see if an edge exists... *)
    IF FindEdge(fromNode, toNode, edgeDummy) THEN RAISE DupEdge END;
    newEdge := NEW(Edge, value := edgeVal, from := fromNode, to := toNode);
    fromNode.succ := RefList.Cons(newEdge, fromNode.succ);
    toNode.pred := RefList.Cons(newEdge, toNode.pred);
    INC(self.edges);
    IF self.undoable THEN
      PushUndo(self, UndoType.AddEdge, NIL, newEdge)
    END (* IF *)
  END AddEdge;

PROCEDURE NodeValToNode(self: T; nodeVal: NodeVal.T;
                        addNodes: BOOLEAN): Node
    RAISES { NoSuchNode } =
  VAR nodeRA: REFANY;
  BEGIN
    WITH nvr = NEW(NodeValRef) DO
      nvr^ := nodeVal;
      IF NOT self.nodeTbl.get(nvr, nodeRA) THEN
        IF addNodes THEN
          self.addNode(nodeVal); <*NOWARN*>
          VAR dummy := self.nodeTbl.get(nvr, nodeRA); BEGIN
            <*ASSERT dummy*>
            RETURN nodeRA
          END (* BEGIN *)
        ELSE
          RAISE NoSuchNode;
        END (* IF *);
      ELSE
        RETURN nodeRA
      END (* IF *);
    END (* WITH *);
  END NodeValToNode;

PROCEDURE EdgeExists(self: T; node1, node2: NodeVal.T): BOOLEAN =
  VAR
    fromNode, toNode: Node;
    edgeDummy: Edge;
  BEGIN
    TRY
      fromNode := self.nodeValToNode(node1, FALSE);
      toNode := self.nodeValToNode(node2, FALSE);
    EXCEPT
    | NoSuchNode => RETURN FALSE;
    END;
    RETURN FindEdge(fromNode, toNode, edgeDummy);
  END EdgeExists;

PROCEDURE GetEdge(self: T; node1, node2: NodeVal.T;
                  VAR ev: EdgeVal.T): BOOLEAN =
  VAR fromNode, toNode: Node;
      edge: Edge;
  BEGIN
    TRY
      fromNode := self.nodeValToNode(node1, FALSE);
      toNode := self.nodeValToNode(node2, FALSE);
    EXCEPT
    | NoSuchNode => RETURN FALSE;
    END;
    IF NOT FindEdge(fromNode, toNode, edge) THEN
      RETURN FALSE;
    ELSE
      ev := edge.value;
      RETURN TRUE;
    END (* IF *);
  END GetEdge;

Requires that 'fromNode' and 'toNode' are nodes in 'g'. If no edge exists between 'fromNode' and 'toNode', returns FALSE; if such an edge does exist, return TRUE and the value of that edge in 'edgeVal'.

PROCEDURE FindEdge(fromNode, toNode: Node;
                   VAR (*OUT*) edge: Edge): BOOLEAN =
  VAR
    succs: RefList.T (* OF Edge *);
  BEGIN
    succs := fromNode.succ;
    WHILE succs # NIL DO
      edge := succs.head;
      IF edge.to = toNode THEN RETURN TRUE; END;
      succs := succs.tail
    END;
    RETURN FALSE;
  END FindEdge;

PROCEDURE EdgeValue(self: T; node1, node2: NodeVal.T): EdgeVal.T
    RAISES { NoSuchNode, NoSuchEdge } =
  VAR
    fromNode, toNode: Node;
    edge: Edge;
  BEGIN
    (* These raise NoSuchNode. *)
    fromNode := self.nodeValToNode(node1, FALSE);
    toNode := self.nodeValToNode(node2, FALSE);
    IF NOT FindEdge(fromNode, toNode, edge) THEN
      RAISE NoSuchEdge;
    ELSE
      RETURN edge.value;
    END;
  END EdgeValue;

PROCEDURE DeleteEdge(self: T; node1, node2: NodeVal.T)
    RAISES { NoSuchNode, NoSuchEdge } =
  VAR
    fromNode, toNode: Node;
    foundFrom, foundTo: BOOLEAN;
  BEGIN
    (* These raise NoSuchNode. *)
    fromNode := self.nodeValToNode(node1, FALSE);
    toNode := self.nodeValToNode(node2, FALSE);

    IF self.undoable THEN
      VAR edge: Edge; BEGIN
        IF FindEdge(fromNode, toNode, edge) THEN
          PushUndo(self, UndoType.DeleteEdge, NIL, edge)
        ELSE
          RAISE NoSuchEdge
        END (* IF *)
      END (* BEGIN *)
    END (* IF *);

    foundFrom := DeleteFromEdgeList(fromNode.succ, FALSE, toNode);
    foundTo := DeleteFromEdgeList(toNode.pred, TRUE, fromNode);
    IF foundFrom THEN
      <*ASSERT foundTo*>
      DEC(self.edges)
    ELSE
      <*ASSERT NOT foundTo*>
      RAISE NoSuchEdge;
    END;
  END DeleteEdge;

Attempts to deletes an edge whose target is 'targetNode' from 'realEdges'. If 'targetIsFromNode' is TRUE, target is interpreted to mean the from field of an edge, else the to field. Returns TRUE iff found and deleted a matching edge.

PROCEDURE DeleteFromEdgeList(VAR realEdges: RefList.T (* Of Edge *);
                             targetIsFromNode: BOOLEAN;
                             targetNode: Node): BOOLEAN =
  VAR edges, prevEdges: RefList.T (* Of Edge *);
      edge: Edge;
  BEGIN
    prevEdges := NIL;
    IF realEdges = NIL THEN RETURN FALSE; END;
    edges := realEdges;
    WHILE edges # NIL DO
      edge := edges.head;
      IF targetIsFromNode AND (edge.from = targetNode) THEN
        IF prevEdges = NIL THEN realEdges := edges.tail
        ELSE prevEdges.tail := edges.tail
        END;
        RETURN TRUE;
      ELSIF (NOT targetIsFromNode) AND (edge.to = targetNode) THEN
        IF prevEdges = NIL THEN realEdges := edges.tail
        ELSE prevEdges.tail := edges.tail
        END;
        RETURN TRUE;
      END;
      prevEdges := edges; edges := edges.tail;
    END;
    RETURN FALSE;
  END DeleteFromEdgeList;

PROCEDURE ChangeEdge(self: T; node1: NodeVal.T;
                     edgeVal: EdgeVal.T; node2: NodeVal.T)
            RAISES { NoSuchNode, NoSuchEdge } =
  VAR
    fromNode, toNode: Node;
    edge: Edge;
  BEGIN
    (* These raise NoSuchNode. *)
    fromNode := self.nodeValToNode(node1, FALSE);
    toNode := self.nodeValToNode(node2, FALSE);
    IF NOT FindEdge(fromNode, toNode, edge) THEN
      RAISE NoSuchEdge;
    ELSE
      IF self.undoable THEN PushEdgeVal(self, edge, edge.value) END (* IF *);
      edge.value := edgeVal;
    END;
  END ChangeEdge;

PROCEDURE SetEdge(self: T; node1: NodeVal.T;
                  edgeVal: EdgeVal.T; node2: NodeVal.T)
            RAISES { NoSuchNode } =
  VAR
    fromNode, toNode: Node;
    edge: Edge;
  BEGIN
    (* These raise NoSuchNode. *)
    fromNode := self.nodeValToNode(node1, FALSE);
    toNode := self.nodeValToNode(node2, FALSE);
    IF NOT FindEdge(fromNode, toNode, edge) THEN
      edge := NEW(Edge, value := edgeVal, from := fromNode, to := toNode);
      fromNode.succ := RefList.Cons(edge, fromNode.succ);
      toNode.pred := RefList.Cons(edge, toNode.pred);
      IF self.undoable THEN
        PushUndo(self, UndoType.AddEdge, NIL, edge)
      END (* IF *);
      INC(self.edges);
    ELSE
      IF self.undoable THEN PushEdgeVal(self, edge, edge.value) END (* IF *);
      edge.value := edgeVal;
    END;
  END SetEdge;

PROCEDURE NSucc(self: T; nodeVal: NodeVal.T): CARDINAL
    RAISES { NoSuchNode } =
  BEGIN
    RETURN RefList.Length(self.nodeValToNode(nodeVal, FALSE).succ);
  END NSucc;

PROCEDURE GetSuccN(self: T; nodeVal: NodeVal.T; n: CARDINAL): NodeVal.T
    RAISES { NoSuchNode, RangeFault } =
  VAR
    node: Node;
  BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    IF (n < 0) OR (n >= RefList.Length(node.succ)) THEN
      RAISE RangeFault;
    ELSE
      RETURN NARROW(RefList.Nth(node.succ, n), Edge).to.value;
    END;
  END GetSuccN;

PROCEDURE GetSuccIter(self: T; nodeVal: NodeVal.T): NodeIter
    RAISES { NoSuchNode } =
  VAR
    node: Node;
    ni: NodeIter;
  BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    ni := NEW(NodeIterImpl, toNotFrom := TRUE, list := node.succ);
    RETURN ni;
  END GetSuccIter;

PROCEDURE GetSuccList(self: T; nodeVal: NodeVal.T): RefList.T
    RAISES { NoSuchNode } =
  VAR node: Node; BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    RETURN node.succ
  END GetSuccList;

PROCEDURE NPred(self: T; nodeVal: NodeVal.T): CARDINAL
    RAISES { NoSuchNode } =
  BEGIN
    RETURN RefList.Length(self.nodeValToNode(nodeVal, FALSE).pred);
  END NPred;

PROCEDURE GetPredN(self: T; nodeVal: NodeVal.T; n: CARDINAL): NodeVal.T
    RAISES { NoSuchNode, RangeFault } =
  VAR
    node: Node;
  BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    IF (n < 0) OR (n >= RefList.Length(node.pred)) THEN
      RAISE RangeFault;
    ELSE
      RETURN NARROW(RefList.Nth(node.pred, n), Edge).from.value;
    END;
  END GetPredN;

PROCEDURE GetPredIter(self: T; nodeVal: NodeVal.T): NodeIter
    RAISES { NoSuchNode } =
  VAR
    node: Node;
    ni: NodeIter;
  BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    ni := NEW(NodeIterImpl, toNotFrom := FALSE, list := node.pred);
    RETURN ni;
  END GetPredIter;

PROCEDURE GetPredList(self: T; nodeVal: NodeVal.T): RefList.T
    RAISES { NoSuchNode } =
  VAR node: Node; BEGIN
    node := self.nodeValToNode(nodeVal, FALSE);
    RETURN node.succ
  END GetPredList;

PROCEDURE NodeIterNext(self: NodeIterImpl; VAR next: NodeVal.T): BOOLEAN =
  VAR
    edge: Edge;
  BEGIN
    IF self.list = NIL THEN RETURN FALSE; END;
    edge := self.list.head;
    self.list := self.list.tail;
    IF self.toNotFrom THEN
      next := edge.to.value;
    ELSE
      next := edge.from.value;
    END;
    RETURN TRUE;
  END NodeIterNext;

PROCEDURE SetMiscs(g: T; i: INTEGER) =
  VAR iter := g.nodeTbl.iterate();
      nodeVal, nodeRA: REFANY;
  BEGIN
    WHILE iter.next(nodeVal, nodeRA) DO
      VAR node: Node := nodeRA; BEGIN
        node.misc := i
      END (* BEGIN *)
    END (* WHILE *)
  END SetMiscs;

PROCEDURE MapOverEdges(self: T; emp: EdgeMapProc) RAISES ANY =
  VAR iter := self.nodeTbl.iterate(); nodeVal, nodeRA: REFANY; BEGIN
    SetMiscs(self, 0);
    WHILE iter.next(nodeVal, nodeRA) DO
      DfsEdges(nodeRA, emp)
    END (* WHILE *);
    SetMiscs(self, 0);
  END MapOverEdges;

PROCEDURE DfsEdges(node: Node; emp: EdgeMapProc) RAISES ANY =
  BEGIN
    IF node.misc = 0 THEN
      VAR succs := node.succ; BEGIN
        WHILE succs # NIL DO
          VAR e: Edge := succs.head; BEGIN
            emp(node.value, e.value, e.to.value);
            node.misc := 1;
            DfsEdges(e.to, emp);
          END (* BEGIN *);
          succs := succs.tail
        END (* WHILE *)
      END (* BEGIN *)
    END (* IF *);
  END DfsEdges;

PROCEDURE MapOverNodes(self: T; nmp: NodeMapProc) =
  VAR iter := self.nodeTbl.iterate(); nodeValRA, nodeRA: REFANY; BEGIN
    WHILE iter.next(nodeValRA, nodeRA) DO
      VAR nodeVal: NodeValRef := nodeValRA; BEGIN
        nmp(nodeVal^)
      END (* BEGIN *)
    END (* WHILE *)
  END MapOverNodes;

PROCEDURE DfsNodes(ra: REFANY; <*UNUSED*> key: REFANY; VAR nodeRA: REFANY): BOOLEAN RAISES ANY = BEGIN WITH node = NARROW(nodeRA, Node), nmpRR = NARROW(ra, NMPRefRec) DO DfsNodesMap(node, nmpRR.proc); END (* WITH

;
    RETURN FALSE;
  END DfsNodes;

PROCEDURE DfsNodesMap(n: Node; nmp: NodeMapProc) RAISES ANY =
  VAR succs: RefList.T (* OF Edge *);
  BEGIN
    IF n.misc = 1 THEN RETURN;
    ELSE
      n.misc := 1;
      nmp(n.value);
      succs := n.succ;
      WHILE succs # NIL DO
        VAR e: Edge := succs.head; BEGIN
          DfsNodesMap(e.to, nmp);
        END (* BEGIN *)
      END (* WHILE *)
    END (* IF *);
  END DfsNodesMap;
*)

PROCEDURE TransitiveClose(self: T; edgeChange: EdgeMapProc := NIL): BOOLEAN =
  VAR nodei, nodej, nodek: Node;
      edge, kkedge, ikedge, ijedge, kjedge: Edge;
      kkValClosure, ikVal, oldijVal, newijVal, kjVal: EdgeVal.T;
      succs: RefList.T (* OF Edge *);
      nodeArr: NodeArr;
      nNodes: CARDINAL;
  BEGIN
    <*ASSERT self.csr # NIL *>
    (* Repack the array so we can index the nodes. *)
    nodeArr := self.makeNodeArray();
    nNodes := self.nodeSize();
    (* I'm going to code up an algorithm that assumes a sparse graph,
       where most of the values are represented by the lack of an edge
       (which corresponds to self.csr.plusIdent).  We might want to
       measure the number of edges against the number of nodes, and
       decide whether to do a "dense" version, in which we allocate an
       n^2 array... *)
    FOR k := 0 TO nNodes-1 DO
      nodek := nodeArr[k];

      IF NOT FindEdge(nodek, nodek, kkedge) THEN
        kkValClosure := self.csr.closure(self.csr.plusIdent);
      ELSE
        kkValClosure := self.csr.closure(kkedge.value);
      END;
      IF kkValClosure = self.csr.bottom THEN RETURN FALSE END (* IF *);

      FOR i := 0 TO nNodes-1 DO
        nodei := nodeArr[i];

        IF NOT FindEdge(nodei, nodek, ikedge) THEN
          ikVal := self.csr.plusIdent;
        ELSE
          ikVal := ikedge.value;
        END;

        FOR j := 0 TO nNodes-1 DO
          nodej := nodeArr[j];
          IF NOT FindEdge(nodei, nodej, ijedge) THEN
            oldijVal := self.csr.plusIdent;
          ELSE
            oldijVal := ijedge.value;
          END;

          IF NOT FindEdge(nodek, nodej, kjedge) THEN
            kjVal := self.csr.plusIdent;
          ELSE
            kjVal := kjedge.value;
          END;

          newijVal := self.csr.plus(
                               oldijVal,
                               self.csr.times(ikVal,
                                              self.csr.times(kkValClosure,
                                                             kjVal)));
          IF (newijVal # self.csr.plusIdent) THEN
            (* There needs to be an edge... *)
            IF (oldijVal = self.csr.plusIdent) THEN
              (* ...but there was no edge before, so make one. *)
              ijedge := NEW(Edge);
              (* To make sure rest of this iteration is right. *)
              ijedge.value := self.csr.plusIdent;
              ijedge.nextValue := newijVal;
              ijedge.from := nodei;
              ijedge.to := nodej;
              nodei.succ := RefList.Cons(ijedge, nodei.succ);
              nodej.pred := RefList.Cons(ijedge, nodej.pred);
              IF self.undoable THEN
                PushUndo(self, UndoType.AddEdge, NIL, ijedge)
              END (* IF *);
              IF edgeChange # NIL THEN
                edgeChange(nodei.value, ijedge.value, nodej.value)
              END (* IF *);
              INC(self.edges);
            ELSE
              (* ...and there is. *)
              ijedge.nextValue := newijVal;
            END;
          END;
        END;
      END;

      (* Now update the 'values' of the edges to the 'nextValues.' *)
      FOR i := 0 TO nNodes-1 DO
        nodei := nodeArr[i];
        succs := nodei.succ;
        WHILE succs # NIL DO
          edge := succs.head;
          IF self.undoable AND edge.value # edge.nextValue THEN
            PushEdgeVal(self, edge, edge.value)
          END (* IF *);
          edge.value := edge.nextValue;
          succs := succs.tail
        END;
      END
    END;
    RETURN TRUE
  END TransitiveClose;

PROCEDURE AddEdgeAndClose(self: T;
                          n1: NodeVal.T; ev: EdgeVal.T; n2: NodeVal.T;
                          addNodes := FALSE;
                          edgeChange: EdgeMapProc := NIL): BOOLEAN =
  VAR oldVal, newVal: EdgeVal.T; BEGIN
    <*ASSERT self.csr # NIL *>
    IF addNodes THEN
      IF NOT NodeExists(self, n1) THEN
        AddNode(self, n1) <*NOWARN*>
      END (* IF *);
      IF NOT NodeExists(self, n2) THEN
        AddNode(self, n2) <*NOWARN*>
      END (* IF *)
    END (* IF *);
    IF NOT self.getEdge(n1, n2, oldVal) THEN
      oldVal := self.csr.plusIdent;
    END (* IF *);
    newVal := self.csr.plus(oldVal, ev);
    IF oldVal = newVal THEN
      RETURN TRUE
    ELSIF newVal = self.csr.bottom THEN
      RETURN FALSE
    ELSE
      IF edgeChange # NIL THEN edgeChange(n1, newVal, n2) END (* IF *);
      self.setEdge(n1, newVal, n2); <*NOWARN*>
      RETURN CloseOnPreds(self, newVal, n1, n2, edgeChange) AND
             CloseOnSuccs(self, newVal, n1, n2, edgeChange)
    END (* IF *);
  END AddEdgeAndClose;

PROCEDURE CloseOnPreds(self: T; newVal: EdgeVal.T;
                       n1, n2: NodeVal.T;
                       edgeChange: EdgeMapProc): BOOLEAN =
  VAR ni: NodeIter := self.getPredIter(n1); <*NOWARN*>
      pred: NodeVal.T;
      oldEdge, predEdge, newEdge: EdgeVal.T;
  BEGIN
    WHILE ni.next(pred) DO
      predEdge := self.edgeValue(pred, n1); <*NOWARN*>
      IF NOT self.getEdge(pred, n2, oldEdge) THEN
        oldEdge := self.csr.plusIdent;
      END (* IF *);
      newEdge := self.csr.plus(oldEdge, self.csr.times(predEdge, newVal));
      IF newEdge # self.csr.plusIdent THEN
        IF pred = n2 THEN
          (* We have a cycle! Set the edges between n1 and n2 to the closure
             of the edge we we about to add. *)
          VAR closeVal := self.csr.closure(newEdge); BEGIN
            IF closeVal = self.csr.bottom THEN
              RETURN FALSE
            ELSE
              IF NOT self.addEdgeAndClose(n1, closeVal, n2,
                                          FALSE, edgeChange) THEN
                RETURN FALSE
              END (* IF *);
              IF NOT self.addEdgeAndClose(n2, closeVal, n1,
                                          FALSE, edgeChange) THEN
                RETURN FALSE
              END (* IF *);
            END (* IF *)
          END (* WITH *);
        ELSE
          IF NOT self.addEdgeAndClose(pred, newEdge, n2,
                                      FALSE, edgeChange) THEN
            RETURN FALSE
          END (* IF *)
        END (* IF *)
      END (* IF *)
    END (* WHILE *);
    RETURN TRUE
  END CloseOnPreds;

PROCEDURE CloseOnSuccs(self: T; newVal: EdgeVal.T;
                       n1, n2: NodeVal.T;
                       edgeChange: EdgeMapProc): BOOLEAN =
  VAR ni: NodeIter := self.getSuccIter(n2); <*NOWARN*>
      succ: NodeVal.T;
      oldEdge, succEdge, newEdge: EdgeVal.T;
  BEGIN
    WHILE ni.next(succ) DO
      succEdge := self.edgeValue(n2, succ); <*NOWARN*>
      IF NOT self.getEdge(n1, succ, oldEdge) THEN
        oldEdge := self.csr.plusIdent;
      END (* IF *);
      newEdge := self.csr.plus(oldEdge, self.csr.times(newVal, succEdge));
      IF newEdge # self.csr.plusIdent THEN
        IF n1 = succ THEN
          (* We have a cycle! Set the edges between n1 and n2 to the closure
             of the edge we we about to add. *)
          VAR closeVal := self.csr.closure(newEdge); BEGIN
            IF closeVal = self.csr.bottom THEN
              RETURN FALSE
            ELSE
              IF NOT self.addEdgeAndClose(n1, closeVal, n2,
                                          FALSE, edgeChange) THEN
                RETURN FALSE
              END (* IF *);
              IF NOT self.addEdgeAndClose(n2, closeVal, n1,
                                          FALSE, edgeChange) THEN
                RETURN FALSE
              END (* IF *);
            END (* IF *)
          END (* WITH *);
        ELSE
          IF NOT self.addEdgeAndClose(n1, newEdge, succ,
                                      FALSE, edgeChange) THEN
            RETURN FALSE
          END (* IF *)
        END (* IF *);
      END (* IF *);
    END (* WHILE *);
    RETURN TRUE
  END CloseOnSuccs;

PROCEDURE TopSort(self: T;
                  VAR (*OUT*) res: REF ARRAY OF NodeVal.T): BOOLEAN =
  VAR nodes := NEW(REF ARRAY OF Node, self.nodeSize());
      cycle := NEW(RefSeq.T).init();
      cur := LAST(nodes^);
  (* Returns TRUE and sets "res" only if it finds a cycle;
     otherwise, filles in "nodes" right to left. *)
  PROCEDURE TopSortWork(n: Node): BOOLEAN =
    BEGIN
      IF Word.And(n.misc, 2) # 0 THEN
        WHILE cycle.getlo() # n DO EVAL cycle.remlo() END (* WHILE *);
        res := NEW(REF ARRAY OF NodeVal.T, cycle.size());
        FOR k := 0 TO LAST(res^) DO
          res[k] := NARROW(cycle.get(k), Node).value
        END (* FOR *);
        RETURN TRUE
      ELSIF Word.And(n.misc, 1) # 0 THEN
        RETURN FALSE
      ELSE
        cycle.addhi(n); n.misc := 2;
        VAR succ := n.succ; BEGIN
          WHILE succ # NIL DO
            VAR e: Edge := succ.head; BEGIN
              IF TopSortWork(e.to) THEN RETURN TRUE END (* IF *)
            END (* BEGIN *);
            succ := succ.tail
          END (* WHILE *)
        END (* BEGIN *);
        EVAL cycle.remhi();
        nodes[cur] := n; DEC(cur);
        n.misc := 1;
        RETURN FALSE
      END (* IF *)
    END TopSortWork;
  BEGIN
    SetMiscs(self, 0);
    (* First, find the roots. *)
    VAR iter := self.nodeTbl.iterate(); nodeValRA, nodeRA: REFANY; BEGIN
      WHILE iter.next(nodeValRA, nodeRA) DO
        VAR node: Node := nodeRA; BEGIN
          IF TopSortWork(node) THEN RETURN FALSE END (* IF *)
        END (* BEGIN *)
      END (* WHILE *)
    END (* BEGIN *);
    res := NEW(REF ARRAY OF NodeVal.T, self.nodeSize());
    FOR i := 0 TO LAST(res^) DO res[i] := nodes[i].value END (* FOR *);
    RETURN TRUE
  END TopSort;

PROCEDURE PrintAsMatrix(self: T; wr: Wr.T;
                        np: NodePrintProc;
                        ep: EdgePrintProc;
                        between, colWidth: CARDINAL;
                        absentEV: EdgeVal.T) =
  VAR
    nodei, nodej: Node;
    edge: Edge;
    nodeArr: NodeArr;
    nNodes: CARDINAL;
  BEGIN
    (* Repack the array so we can index the nodes. *)
    nodeArr := self.makeNodeArray();
    nNodes := self.nodeSize();
    (* Print the top line *)
    FOR i := 1 TO colWidth+1 DO Wr.PutChar(wr, ' '); END;
    FOR i := 0 TO nNodes-1 DO
      FOR j := 1 TO between DO Wr.PutChar(wr, ' '); END;
      nodei := nodeArr[i];
      np(wr, nodei.value, colWidth);
    END;
    Wr.PutChar(wr, '\n');
    FOR i := 1 TO colWidth+between DO Wr.PutChar(wr, ' '); END;
    Wr.PutChar(wr, '+');
    FOR i := 1 TO nNodes*colWidth + (nNodes-1)*between DO
      Wr.PutChar(wr, '-');
    END;
    Wr.PutChar(wr, '\n');

    FOR i := 0 TO nNodes-1 DO
      nodei := nodeArr[i];
      np(wr, nodei.value, colWidth);
      FOR j := 1 TO between DO Wr.PutChar(wr, ' '); END;
      Wr.PutChar(wr, '|');
      FOR j := 0 TO nNodes-1 DO
        nodej := nodeArr[j];
        IF FindEdge(nodei, nodej, edge) THEN
          ep(wr, TRUE, edge.value, colWidth);
        ELSE
          ep(wr, FALSE, absentEV, colWidth);
        END;
        FOR k := 1 TO between DO Wr.PutChar(wr, ' '); END;
      END;
      Wr.PutChar(wr, '\n');
    END;
  END PrintAsMatrix;

PROCEDURE PushUndo(self: T; type: UndoType; n: Node; e: Edge := NIL) =
  BEGIN
    ExpandIfNeed(self);
    WITH top = self.undoStack[self.undoSP] DO
      top.type := type; top.n := n; top.e := e
    END (* WITH *);
    INC(self.undoSP)
  END PushUndo;

PROCEDURE PushEdgeVal(self: T; e: Edge; ev: EdgeVal.T) =
  BEGIN
    ExpandIfNeed(self);
    WITH top = self.undoStack[self.undoSP] DO
      top.type := UndoType.EdgeVal; top.e := e; top.ev := ev
    END (* WITH *);
    INC(self.undoSP)
  END PushEdgeVal;

PROCEDURE ExpandIfNeed(self: T) =
  BEGIN
    IF self.undoSP = NUMBER(self.undoStack^) THEN
      VAR new := NEW(REF ARRAY OF UndoRec, 2*self.undoSP); BEGIN
        SUBARRAY(new^, 0, self.undoSP) := self.undoStack^;
        self.undoStack := new
      END (* BEGIN *);
    END (* IF *)
  END ExpandIfNeed;

PROCEDURE Push(self: T) =
  BEGIN
    <*ASSERT self.undoable *>
    PushUndo(self, UndoType.Mark, NIL);
  END Push;

PROCEDURE Pop(self: T) =
  <*FATAL DupEdge, DupNode, NoSuchNode, NoSuchEdge *>
  BEGIN
    self.undoable := FALSE;
    LOOP
      IF self.undoSP < NUMBER(self.undoStack^) THEN
        self.undoStack[self.undoSP].n := NIL;
        self.undoStack[self.undoSP].e := NIL
      END (* IF *);
      DEC(self.undoSP);
      WITH top = self.undoStack[self.undoSP] DO
        CASE top.type OF
        | UndoType.Mark =>
            EXIT
        | UndoType.AddNode =>
            self.deleteNode(top.n.value)
        | UndoType.DeleteNode =>
            self.addNode(top.n.value)
        | UndoType.AddEdge =>
            self.deleteEdge(top.e.from.value, top.e.to.value)
        | UndoType.DeleteEdge =>
            self.addEdge(top.e.from.value, top.e.value, top.e.to.value)
        | UndoType.EdgeVal =>
            top.e.value := top.ev
        END (* CASE *)
      END (* WITH *)
    END (* LOOP *);
    self.undoable := TRUE
  END Pop;

BEGIN
END DiGraph.