Initial commit

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2013, Tristan Ravitch
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tristan Ravitch nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

haggle.cabal

@@ -0,0 +1,22 @@
+name: haggle
+version: 0.1.0.0
+synopsis: Another Haskell graph library
+-- description:
+license: BSD3
+license-file: LICENSE
+author: Tristan Ravitch
+maintainer: travitch@cs.wisc.edu
+-- copyright:
+category: Data
+build-type: Simple
+cabal-version: >=1.8
+
+library
+  hs-source-dirs: src
+  ghc-options: -Wall
+  exposed-modules: Data.Graph.Haggle.Digraph
+  -- other-modules:
+  build-depends: base == 4.*,
+                 vector >= 0.9,
+                 primitive >= 0.4,
+                 monad-primitive

src/Data/Graph/Haggle/Digraph.hs

@@ -0,0 +1,85 @@
+module Data.Graph.Haggle.Digraph (
+  Vertex,
+  MGraph,
+  new,
+  newSized,
+  addVertex,
+  ) where
+
+import Control.Monad.Primitive
+import Data.PrimRef
+
+import qualified Data.Vector.Unboxed.Mutable as MUV
+import qualified Data.Vector.Unboxed as UV
+
+-- The edge roots vector is indexed by vertex id.  A -1 in the
+-- vector indicates that there are no edges leaving the vertex.
+-- Any other value is an index into BOTH the graphEdgeTarget and
+-- graphEdgeNext vectors.
+--
+-- The graphEdgeTarget vector contains the vertex id of an edge
+-- target.
+--
+-- The graphEdgeNext vector contains, at the same index, the index
+-- of the next edge in the edge list (again into Target and Next).
+-- A -1 indicates no more edges.
+data MGraph m = MGraph { graphVertexCount :: PrimRef m Int
+                       , graphEdgeRoots :: PrimRef m (MUV.MVector (PrimState m) Int)
+                       , graphEdgeCount :: PrimRef m Int
+                       , graphEdgeTarget :: PrimRef m (MUV.MVector (PrimState m) Int)
+                       , graphEdgeNext :: PrimRef m (MUV.MVector (PrimState m) Int)
+                       }
+
+type Vertex = Int
+
+defaultSize :: Int
+defaultSize = 128
+
+new :: (PrimMonad m) => m (MGraph m)
+new = newSized defaultSize
+
+newSized :: (PrimMonad m) => Int -> m (MGraph m)
+newSized sz = do
+  nn <- newPrimRef 0
+  en <- newPrimRef 0
+  nVec <- MUV.new sz
+  nVecRef <- newPrimRef nVec
+  eTarget <- MUV.new sz
+  eTargetRef <- newPrimRef eTarget
+  eNext <- MUV.new sz
+  eNextRef <- newPrimRef eNext
+  return $! MGraph { graphVertexCount = nn
+                   , graphEdgeRoots = nVecRef
+                   , graphEdgeCount = en
+                   , graphEdgeTarget = eTargetRef
+                   , graphEdgeNext = eNextRef
+                   }
+
+-- | Add a new 'Vertex' to an 'MGraph', returning the new 'Vertex' id.
+-- The new vertex is initialized to have no outgoing edges.
+addVertex :: (PrimMonad m) => MGraph m -> m Vertex
+addVertex g = do
+  ensureSpace g
+  vid <- readPrimRef r
+  modifyPrimRef' r (+1)
+  vec <- readPrimRef (graphEdgeRoots g)
+  MUV.write vec vid (-1)
+  return vid
+  where
+    r = graphVertexCount g
+
+-- Helpers
+
+-- | Given a graph, ensure that there is space in the vertex vector
+-- for a new vertex.  If there is not, double the capacity.
+ensureSpace :: (PrimMonad m) => MGraph m -> m ()
+ensureSpace g = do
+  vec <- readPrimRef (graphEdgeRoots g)
+  let cap = MUV.length vec
+  cnt <- readPrimRef (graphVertexCount g)
+  case cnt < cap of
+    True -> return ()
+    False -> do
+      vec' <- MUV.grow vec cap
+      writePrimRef (graphEdgeRoots g) vec'
+