graph_appel.sml

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