81 lines
2.2 KiB
Standard ML
81 lines
2.2 KiB
Standard ML
|
structure Graph :> GRAPH =
|
||
|
|
struct
|
||
|
|
type node' = int
|
||
|
|
type temp = Temp.temp
|
||
|
|
|
||
|
|
datatype noderep = NODE of {succ: node' list, pred: node' list}
|
||
|
|
|
||
|
|
val emptyNode = NODE{succ=[],pred=[]}
|
||
|
|
|
||
|
|
val bogusNode = NODE{succ=[~1],pred=[]}
|
||
|
|
|
||
|
|
fun isBogus(NODE{succ= ~1::_,...}) = true
|
||
|
|
| isBogus _ = false
|
||
|
|
|
||
|
|
structure A = DynamicArrayFn(struct open Array
|
||
|
|
type elem = noderep
|
||
|
|
type vector = noderep vector
|
||
|
|
type array = noderep array
|
||
|
|
end)
|
||
|
|
|
||
|
|
type graph = A.array
|
||
|
|
|
||
|
|
type node = graph * node'
|
||
|
|
fun eq((_,a),(_,b)) = a=b
|
||
|
|
|
||
|
|
fun augment (g: graph) (n: node') : node = (g,n)
|
||
|
|
|
||
|
|
fun newGraph() = A.array(0,bogusNode)
|
||
|
|
|
||
|
|
fun nodes g = let val b = A.bound g
|
||
|
|
fun f i = if isBogus( A.sub(g,i)) then nil
|
||
|
|
else (g,i)::f(i+1)
|
||
|
|
in f 0
|
||
|
|
end
|
||
|
|
|
||
|
|
fun succ(g,i) = let val NODE{succ=s,...} = A.sub(g,i)
|
||
|
|
in map (augment g) s
|
||
|
|
end
|
||
|
|
fun pred(g,i) = let val NODE{pred=p,...} = A.sub(g,i)
|
||
|
|
in map (augment g) p
|
||
|
|
end
|
||
|
|
fun adj gi = pred gi @ succ gi
|
||
|
|
|
||
|
|
fun newNode g = (* binary search for unused node *)
|
||
|
|
let fun look(lo,hi) =
|
||
|
|
(* i < lo indicates i in use
|
||
|
|
i >= hi indicates i not in use *)
|
||
|
|
if lo=hi then (A.update(g,lo,emptyNode); (g,lo))
|
||
|
|
else let val m = (lo+hi) div 2
|
||
|
|
in if isBogus(A.sub(g,m)) then look(lo,m) else look(m+1,hi)
|
||
|
|
end
|
||
|
|
in look(0, 1 + A.bound g)
|
||
|
|
end
|
||
|
|
|
||
|
|
exception GraphEdge
|
||
|
|
fun check(g,g') = (* if g=g' then () else raise GraphEdge *) ()
|
||
|
|
|
||
|
|
fun delete(i,j::rest) = if i=j then rest else j::delete(i,rest)
|
||
|
|
| delete(_,nil) = raise GraphEdge
|
||
|
|
|
||
|
|
fun diddle_edge change {from=(g:graph, i),to=(g':graph, j)} =
|
||
|
|
let val _ = check(g,g')
|
||
|
|
val NODE{succ=si,pred=pi} = A.sub(g,i)
|
||
|
|
val _ = A.update(g,i,NODE{succ=change(j,si),pred=pi})
|
||
|
|
val NODE{succ=sj,pred=pj} = A.sub(g,j)
|
||
|
|
val _ = A.update(g,j,NODE{succ=sj,pred=change(i,pj)})
|
||
|
|
in ()
|
||
|
|
end
|
||
|
|
|
||
|
|
val mk_edge = diddle_edge (op ::)
|
||
|
|
val rm_edge = diddle_edge delete
|
||
|
|
|
||
|
|
structure Table = IntMapTable(type key = node
|
||
|
|
fun getInt(g,n) = n)
|
||
|
|
|
||
|
|
|
||
|
|
fun nodename(g,i:int) = "n" ^ Int.toString(i)
|
||
|
|
|
||
|
|
end
|
||
|
|
|