Artifact 0d5893505cae5cd1208aff43417c5cf319d3bc1e
File
tools/cvs2fossil/lib/c2f_cyclebreaker.tcl
part of check-in
[5f5620fbd2]
- Modified cycle breaker API. Hook for processed nodes now takes the graph as new first argument. Extended API, exposed method for dumping the current state of the graph, including ability to dump a sub graph.
by
aku on
2007-11-23 05:43:25.
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals. For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################
## This file provides a helper package for the passes 6 and 7 which
## contains the common code of the cycle breaking algorithm.
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require struct::graph ; # Graph handling.
package require struct::list ; # Higher order list operations.
package require vc::tools::dot ; # User feedback. DOT export.
package require vc::tools::log ; # User feedback.
package require vc::tools::trouble ; # Error reporting.
package require vc::tools::misc ; # Text formatting.
package require vc::fossil::import::cvs::project::rev ; # Project level changesets
package require vc::fossil::import::cvs::project::revlink ; # Cycle links.
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::cyclebreaker {
# # ## ### ##### ######## #############
## Public API
typemethod precmd {cmd} {
::variable myprecmd $cmd
return
}
typemethod savecmd {cmd} {
::variable mysavecmd $cmd
return
}
typemethod breakcmd {cmd} {
::variable mybreakcmd $cmd
return
}
# # ## ### ##### ######## #############
typemethod dotsto {path} {
::variable mydotdestination $path
return
}
typemethod dot {label changesets} {
::variable mydotprefix $label
::variable mydotid 0
set dg [Setup $changesets 0]
Mark $dg
$dg destroy
return
}
typemethod mark {graph suffix {subgraph {}}} {
Mark $graph $suffix $subgraph
return
}
# # ## ### ##### ######## #############
typemethod run {label changesetcmd} {
::variable myat 0
::variable mydotprefix $label
::variable mydotid 0
# We create a graph of the revision changesets, using the file
# level dependencies to construct a first approximation of the
# dependencies at the project level. Then we look for cycles
# in that graph and break them.
# 1. Create nodes for all relevant changesets and a mapping
# from the revisions to their changesets/nodes.
set changesets [uplevel #0 $changesetcmd]
set dg [Setup $changesets]
# 3. Lastly we iterate the graph topologically. We mark off
# the nodes which have no predecessors, in order from
# oldest to youngest, saving and removing dependencies. If
# we find no nodes without predecessors we have a cycle,
# and work on breaking it.
log write 3 cyclebreaker {Now sorting the changesets, breaking cycles}
InitializeCandidates $dg
while {1} {
while {[WithoutPredecessor $dg n]} {
ProcessedHook $dg $n $myat
$dg node delete $n
incr myat
ShowPendingNodes
}
if {![llength [dg nodes]]} break
BreakCycleHook $dg
InitializeCandidates $dg
}
$dg destroy
log write 3 cyclebreaker Done.
ClearHooks
# Reread the graph and dump its final form, if graph export
# was activated.
::variable mydotdestination
if {$mydotdestination eq ""} return
set dg [Setup [uplevel #0 $changesetcmd] 0]
Mark $dg -done
$dg destroy
return
}
# # ## ### ##### ######## #############
typemethod break {graph} {
BreakCycle $graph [FindCycle $graph]
return
}
typemethod replace {graph n replacements} {
Replace $graph $n $replacements
return
}
# # ## ### ##### ######## #############
## Internal methods
proc Setup {changesets {log 1}} {
if {$log} {
log write 3 cyclebreaker "Creating changeset graph, filling with nodes"
log write 3 cyclebreaker "Adding [nsp [llength $changesets] node]"
}
set dg [struct::graph dg]
foreach cset $changesets {
$dg node insert $cset
$dg node set $cset timerange [$cset timerange]
$dg node set $cset label [ID $cset]
$dg node set $cset __id__ [$cset id]
}
# 2. Find for all relevant changeset their revisions and their
# dependencies. Map the latter back to changesets and
# construct the corresponding arcs.
if {$log} {
log write 3 cyclebreaker {Setting up node dependencies}
}
foreach cset $changesets {
foreach succ [$cset successors] {
# Changesets may have dependencies outside of the
# chosen set. These are ignored
if {![$dg node exists $succ]} continue
$dg arc insert $cset $succ
}
}
# Run the user hook to manipulate the graph before
# consummation.
if {$log} { Mark $dg -start }
PreHook $dg
return $dg
}
# Instead of searching the whole graph for the degree-0 nodes in
# each iteration we compute the list once to start, and then only
# update it incrementally based on the outgoing neighbours of the
# node chosen for commit.
proc InitializeCandidates {dg} {
# bottom = list (list (node, range min, range max))
::variable mybottom
foreach n [$dg nodes] {
if {[$dg node degree -in $n]} continue
lappend mybottom [linsert [$dg node get $n timerange] 0 $n]
}
set mybottom [lsort -index 1 -integer [lsort -index 2 -integer $mybottom]]
ShowPendingNodes
return
}
proc WithoutPredecessor {dg nv} {
::variable mybottom
upvar 1 $nv n
if {![llength $mybottom]} { return 0 }
set n [lindex [lindex $mybottom 0] 0]
set mybottom [lrange $mybottom 1 end]
set changed 0
# Update list of nodes without predecessor, based on the
# outgoing neighbours of the chosen node. This should be
# faster than iterating of the whole set of nodes, finding all
# without predecessors, sorting them by time, etc. pp.
foreach out [$dg nodes -out $n] {
if {[$dg node degree -in $out] > 1} continue
# Degree-1 neighbour, will have no predecessors after the
# removal of n. Put on the list.
lappend mybottom [linsert [$dg node get $out timerange] 0 $out]
set changed 1
}
if {$changed} {
set mybottom [lsort -index 1 -integer [lsort -index 2 -integer $mybottom]]
}
# We do not delete the node immediately, to allow the Save
# procedure to save the dependencies as well (encoded in the
# arcs).
return 1
}
proc ShowPendingNodes {} {
if {[log verbosity?] < 10} return
::variable mybottom
log write 10 cyclebreaker \
"Pending: [struct::list map $mybottom [myproc FormatPendingItem]]"
return
}
proc FormatPendingItem {item} { lreplace $item 0 0 <[[lindex $item 0] id]> }
proc FindCycle {dg} {
# This procedure is run if and only the graph is not empty and
# all nodes have predecessors. This means that each node is
# either part of a cycle or (indirectly) depending on a node
# in a cycle. We can start at an arbitrary node, follow its
# incoming edges to its predecessors until we see a node a
# second time. That node closes the cycle and the beginning is
# its first occurence. Note that we can choose an arbitrary
# predecessor of each node as well, we do not have to search.
# We record for each node the index of the first appearance in
# the path, making it easy at the end to cut the cycle from
# it.
# Choose arbitrary node to start our search at.
set start [lindex [$dg nodes] 0]
# Initialize state, path of seen nodes, and when seen.
set path {}
array set seen {}
while {1} {
# Stop searching when we have seen the current node
# already, the circle has been closed.
if {[info exists seen($start)]} break
lappend path $start
set seen($start) [expr {[llength $path]-1}]
# Choose arbitrary predecessor
set start [lindex [$dg nodes -in $start] 0]
}
return [struct::list reverse [lrange $path $seen($start) end]]
}
proc ID {cset} { return "<[$cset id]>" }
proc BreakCycle {dg cycle} {
# The cycle we have gotten is broken by breaking apart one or
# more of the changesets in the cycle. This causes us to
# create one or more changesets which are to be committed,
# added to the graph, etc. pp.
set cprint [join [struct::list map $cycle [myproc ID]] { }]
lappend cycle [lindex $cycle 0] [lindex $cycle 1]
set bestlink {}
set bestnode {}
foreach \
prev [lrange $cycle 0 end-2] \
cset [lrange $cycle 1 end-1] \
next [lrange $cycle 2 end] {
# Each triple PREV -> CSET -> NEXT of changesets, a
# 'link' in the cycle, is analysed and the best
# location where to at least weaken the cycle is
# chosen for further processing.
set link [project::revlink %AUTO% $prev $cset $next]
if {$bestlink eq ""} {
set bestlink $link
set bestnode $cset
} elseif {[$link betterthan $bestlink]} {
$bestlink destroy
set bestlink $link
set bestnode $cset
} else {
$link destroy
}
}
log write 5 cyclebreaker "Breaking cycle ($cprint) by splitting changeset <[$bestnode id]>"
set ID [$bestnode id]
Mark $dg -${ID}-before
set newcsets [$bestlink break]
$bestlink destroy
# At this point the old changeset (BESTNODE) is gone
# already. We remove it from the graph as well and then enter
# the fragments generated for it.
Replace $dg $bestnode $newcsets
Mark $dg -${ID}-after
return
}
# TODO: This should be a graph method.
proc HasArc {dg a b} {
#8.5: return [expr {$b in [$dg nodes -out $a]}]
if {[lsearch -exact [$dg nodes -out $a] $b] < 0} { return 0 }
return 1
}
proc Mark {dg {suffix {}} {subgraph {}}} {
::variable mydotdestination
if {$mydotdestination eq ""} return
::variable mydotprefix
::variable mydotid
set fname $mydotdestination/${mydotprefix}${mydotid}${suffix}.dot
file mkdir [file dirname $fname]
dot write $dg $mydotprefix$suffix $fname $subgraph
incr mydotid
log write 5 cyclebreaker ".dot export $fname"
return
}
proc Replace {dg n replacements} {
# NOTE. We have to get the list of incoming neighbours and
# recompute their successors after the new nodes have been
# inserted. Their outgoing arcs will now go to one or both of
# the new nodes, and not redoing them may cause us to forget
# circles, leaving them in, unbroken.
set pre [$dg nodes -in $n]
$dg node delete $n
foreach cset $replacements {
$dg node insert $cset
$dg node set $cset timerange [$cset timerange]
}
foreach cset $replacements {
foreach succ [$cset successors] {
# The new changesets may have dependencies outside of
# the chosen set. These are ignored
if {![$dg node exists $succ]} continue
$dg arc insert $cset $succ
}
}
foreach cset $pre {
foreach succ [$cset successors] {
# Note that the arc may already exist in the graph. If
# so ignore it. The new changesets may have
# dependencies outside of the chosen set. These are
# ignored
if {![$dg node exists $succ]} continue
if {[HasArc $dg $cset $succ]} continue;# TODO should be graph method.
$dg arc insert $cset $succ
}
}
return
}
# # ## ### ##### ######## #############
## Callback invokation ...
proc PreHook {graph} {
# Give the user of the cycle breaker the opportunity to work
# with the graph between setup and consummation.
::variable myprecmd
if {![llength $myprecmd]} return
uplevel #0 [linsert $myprecmd end $graph]
Mark $graph -pre-done
return
}
proc ProcessedHook {dg cset pos} {
# Give the user of the cycle breaker the opportunity to work
# with the changeset before it is removed from the graph.
::variable mysavecmd
if {![llength $mysavecmd]} return
uplevel #0 [linsert $mysavecmd end $dg $pos $cset]
return
}
proc BreakCycleHook {graph} {
# Call out to the chosen algorithm for cycle breaking. Finding
# a cycle if no breaker was chosen is an error.
::variable mybreakcmd
if {![llength $mybreakcmd]} {
trouble fatal "Found a cycle, expecting none."
exit 1
}
uplevel #0 [linsert $mybreakcmd end $graph]
return
}
proc ClearHooks {} {
::variable myprecmd {}
::variable mysavecmd {}
::variable mybreakcmd {}
return
}
# # ## ### ##### ######## #############
typevariable myat 0 ; # Counter for commit ids for the
# changesets.
typevariable mybottom {} ; # List of the candidate nodes for
# committing.
typevariable myprecmd {} ; # Callback, change graph before walk.
typevariable mysavecmd {} ; # Callback, for each processed node.
typevariable mybreakcmd {} ; # Callback, for each found cycle.
typevariable mydotdestination {} ; # Destination directory for the
# generated .dot files.
typevariable mydotprefix {} ; # Prefix for dot files when
# exporting the graphs.
typevariable mydotid 0 ; # Counter for dot file name
# generation.
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
}
namespace eval ::vc::fossil::import::cvs {
namespace export cyclebreaker
namespace eval cyclebreaker {
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::rev
namespace import ::vc::fossil::import::cvs::project::revlink
}
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::log
namespace import ::vc::tools::trouble
namespace import ::vc::tools::dot
log register cyclebreaker
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::cyclebreaker 1.0
return