| 1 | |
|---|
| 2 | -- | Types for the general graph colorer. |
|---|
| 3 | |
|---|
| 4 | {-# OPTIONS -fno-warn-tabs #-} |
|---|
| 5 | -- The above warning supression flag is a temporary kludge. |
|---|
| 6 | -- While working on this module you are encouraged to remove it and |
|---|
| 7 | -- detab the module (please do the detabbing in a separate patch). See |
|---|
| 8 | -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces |
|---|
| 9 | -- for details |
|---|
| 10 | |
|---|
| 11 | module GraphBase ( |
|---|
| 12 | Triv, |
|---|
| 13 | Graph (..), |
|---|
| 14 | initGraph, |
|---|
| 15 | graphMapModify, |
|---|
| 16 | |
|---|
| 17 | Node (..), newNode, |
|---|
| 18 | ) |
|---|
| 19 | |
|---|
| 20 | |
|---|
| 21 | where |
|---|
| 22 | |
|---|
| 23 | import UniqSet |
|---|
| 24 | import UniqFM |
|---|
| 25 | |
|---|
| 26 | |
|---|
| 27 | -- | A fn to check if a node is trivially colorable |
|---|
| 28 | -- For graphs who's color classes are disjoint then a node is 'trivially colorable' |
|---|
| 29 | -- when it has less neighbors and exclusions than available colors for that node. |
|---|
| 30 | -- |
|---|
| 31 | -- For graph's who's color classes overlap, ie some colors alias other colors, then |
|---|
| 32 | -- this can be a bit more tricky. There is a general way to calculate this, but |
|---|
| 33 | -- it's likely be too slow for use in the code. The coloring algorithm takes |
|---|
| 34 | -- a canned function which can be optimised by the user to be specific to the |
|---|
| 35 | -- specific graph being colored. |
|---|
| 36 | -- |
|---|
| 37 | -- for details, see "A Generalised Algorithm for Graph-Coloring Register Allocation" |
|---|
| 38 | -- Smith, Ramsey, Holloway - PLDI 2004. |
|---|
| 39 | -- |
|---|
| 40 | type Triv k cls color |
|---|
| 41 | = cls -- the class of the node we're trying to color. |
|---|
| 42 | -> UniqSet k -- the node's neighbors. |
|---|
| 43 | -> UniqSet color -- the node's exclusions. |
|---|
| 44 | -> Bool |
|---|
| 45 | |
|---|
| 46 | |
|---|
| 47 | -- | The Interference graph. |
|---|
| 48 | -- There used to be more fields, but they were turfed out in a previous revision. |
|---|
| 49 | -- maybe we'll want more later.. |
|---|
| 50 | -- |
|---|
| 51 | data Graph k cls color |
|---|
| 52 | = Graph { |
|---|
| 53 | -- | All active nodes in the graph. |
|---|
| 54 | graphMap :: UniqFM (Node k cls color) } |
|---|
| 55 | |
|---|
| 56 | |
|---|
| 57 | -- | An empty graph. |
|---|
| 58 | initGraph :: Graph k cls color |
|---|
| 59 | initGraph |
|---|
| 60 | = Graph |
|---|
| 61 | { graphMap = emptyUFM } |
|---|
| 62 | |
|---|
| 63 | |
|---|
| 64 | -- | Modify the finite map holding the nodes in the graph. |
|---|
| 65 | graphMapModify |
|---|
| 66 | :: (UniqFM (Node k cls color) -> UniqFM (Node k cls color)) |
|---|
| 67 | -> Graph k cls color -> Graph k cls color |
|---|
| 68 | |
|---|
| 69 | graphMapModify f graph |
|---|
| 70 | = graph { graphMap = f (graphMap graph) } |
|---|
| 71 | |
|---|
| 72 | |
|---|
| 73 | |
|---|
| 74 | -- | Graph nodes. |
|---|
| 75 | -- Represents a thing that can conflict with another thing. |
|---|
| 76 | -- For the register allocater the nodes represent registers. |
|---|
| 77 | -- |
|---|
| 78 | data Node k cls color |
|---|
| 79 | = Node { |
|---|
| 80 | -- | A unique identifier for this node. |
|---|
| 81 | nodeId :: k |
|---|
| 82 | |
|---|
| 83 | -- | The class of this node, |
|---|
| 84 | -- determines the set of colors that can be used. |
|---|
| 85 | , nodeClass :: cls |
|---|
| 86 | |
|---|
| 87 | -- | The color of this node, if any. |
|---|
| 88 | , nodeColor :: Maybe color |
|---|
| 89 | |
|---|
| 90 | -- | Neighbors which must be colored differently to this node. |
|---|
| 91 | , nodeConflicts :: UniqSet k |
|---|
| 92 | |
|---|
| 93 | -- | Colors that cannot be used by this node. |
|---|
| 94 | , nodeExclusions :: UniqSet color |
|---|
| 95 | |
|---|
| 96 | -- | Colors that this node would prefer to be, in decending order. |
|---|
| 97 | , nodePreference :: [color] |
|---|
| 98 | |
|---|
| 99 | -- | Neighbors that this node would like to be colored the same as. |
|---|
| 100 | , nodeCoalesce :: UniqSet k } |
|---|
| 101 | |
|---|
| 102 | |
|---|
| 103 | -- | An empty node. |
|---|
| 104 | newNode :: k -> cls -> Node k cls color |
|---|
| 105 | newNode k cls |
|---|
| 106 | = Node |
|---|
| 107 | { nodeId = k |
|---|
| 108 | , nodeClass = cls |
|---|
| 109 | , nodeColor = Nothing |
|---|
| 110 | , nodeConflicts = emptyUniqSet |
|---|
| 111 | , nodeExclusions = emptyUniqSet |
|---|
| 112 | , nodePreference = [] |
|---|
| 113 | , nodeCoalesce = emptyUniqSet } |
|---|
| 114 | |
|---|
| 115 | |
|---|
| 116 | |
|---|
| 117 | |
|---|