diff --git a/Data/Graph/Inductive/Monad/IOArray.hs b/Data/Graph/Inductive/Monad/IOArray.hs
index 61f3f9f..2c1c841 100644
--- a/Data/Graph/Inductive/Monad/IOArray.hs
+++ b/Data/Graph/Inductive/Monad/IOArray.hs
@@ -10,104 +10,12 @@ module Data.Graph.Inductive.Monad.IOArray(
     removeDel,
 ) where
 
-import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Monad
-
-import Control.Monad
-import Data.Array
-import Data.Array.IO
-import System.IO.Unsafe
-
-
+import qualified Data.Graph.Inductive.Monad.Primitive as Prim
+import Data.Graph.Inductive.Monad.Primitive hiding (SGr)
+import Control.Monad.Primitive (RealWorld)
 
 ----------------------------------------------------------------------
 -- GRAPH REPRESENTATION
 ----------------------------------------------------------------------
 
-newtype SGr a b = SGr (GraphRep a b)
-
-type GraphRep a b = (Int,Array Node (Context' a b),IOArray Node Bool)
-type Context' a b = Maybe (Adj b,a,Adj b)
-
-type USGr = SGr () ()
-
-
-----------------------------------------------------------------------
--- CLASS INSTANCES
-----------------------------------------------------------------------
-
--- Show
---
-showGraph :: (Show a,Show b) => GraphRep a b -> String
-showGraph (_,a,m) = concatMap showAdj (indices a)
-    where showAdj v | unsafePerformIO (readArray m v) = ""
-                    | otherwise = case a!v of
-                        Nothing      -> ""
-                        Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s'
-                          where s' = unsafePerformIO (removeDel m s)
-
--- | Please not that this instance is unsafe.
-instance (Show a,Show b) => Show (SGr a b) where
-  show (SGr g) = showGraph g
-
--- | Please not that this instance is unsafe.
-instance (Show a,Show b) => Show (IO (SGr a b)) where
-  show g = unsafePerformIO (do {(SGr g') <- g; return (showGraph g')})
-
-{-
-run :: Show (IO a) => IO a -> IO ()
-run x = seq x (print x)
--}
-
--- GraphM
---
-instance GraphM IO SGr where
-  emptyM = emptyN defaultGraphSize
-  isEmptyM g = do {SGr (n,_,_) <- g; return (n==0)}
-  matchM v g = do g'@(SGr (n,a,m)) <- g
-                  case a!v of
-                    Nothing -> return (Nothing,g')
-                    Just (pr,l,su) ->
-                       do b <- readArray m v
-                          if b then return (Nothing,g') else
-                             do s  <- removeDel m su
-                                p' <- removeDel m pr
-                                let p = filter ((/=v).snd) p'
-                                writeArray m v True
-                                return (Just (p,v,l,s),SGr (n-1,a,m))
-  mkGraphM vs es = do m <- newArray (1,n) False
-                      return (SGr (n,pr,m))
-          where nod  = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs)
-                su   = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es)
-                pr   = accum addPre su (map (\(v,w,l)->(w,(l,v))) es)
-                bnds = (minimum vs',maximum vs')
-                vs'  = map fst vs
-                n    = length vs
-                addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s)
-                addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing"
-                addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s)
-                addPre Nothing _ = error "mkGraphM (SGr): addPre Nothing"
-  labNodesM g = do (SGr (_,a,m)) <- g
-                   let getLNode vs (_,Nothing)      = return vs
-                       getLNode vs (v,Just (_,l,_)) =
-                           do b <- readArray m v
-                              return (if b then vs else (v,l):vs)
-                   foldM getLNode [] (assocs a)
-
-defaultGraphSize :: Int
-defaultGraphSize = 100
-
-emptyN :: Int -> IO (SGr a b)
-emptyN n = do m <- newArray (1,n) False
-              return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m))
-
-----------------------------------------------------------------------
--- UTILITIES
-----------------------------------------------------------------------
-
-
-
--- | filter list (of successors\/predecessors) through a boolean ST array
--- representing deleted marks
-removeDel :: IOArray Node Bool -> Adj b -> IO (Adj b)
-removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)})
+type SGr = Prim.SGr RealWorld
diff --git a/Data/Graph/Inductive/Monad/Primitive.hs b/Data/Graph/Inductive/Monad/Primitive.hs
new file mode 100644
index 0000000..77f7041
--- /dev/null
+++ b/Data/Graph/Inductive/Monad/Primitive.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
+    MagicHash, ScopedTypeVariables, TypeFamilies #-}
+
+-- (c) 2002 by Martin Erwig [see file COPYRIGHT]
+-- | Static IOArray-based Graphs
+module Data.Graph.Inductive.Monad.Primitive(
+    -- * Graph Representation
+    SGr(..), GraphRep, Context', USGr,
+    defaultGraphSize, emptyN,
+    -- * Utilities
+    removeDel
+) where
+
+import Data.Graph.Inductive.Graph
+import Data.Graph.Inductive.Monad
+import qualified Data.Graph.Inductive.PatriciaTree as PT
+
+import Control.Monad
+import Control.Monad.Primitive
+import Control.Monad.IO.Class
+import Data.Array
+import Data.Primitive.Array hiding (Array)
+import GHC.Exts (Int(..))
+import GHC.Prim (sizeofMutableArray#)
+import Data.Foldable (foldr)
+import Prelude hiding (foldr)
+
+
+----------------------------------------------------------------------
+-- GRAPH REPRESENTATION
+----------------------------------------------------------------------
+
+newtype SGr s a b = SGr (GraphRep s a b)
+
+type GraphRep s a b = (Int,Array Node (Context' a b),MutableArray s Bool)
+type Context'   a b = Maybe (Adj b,a,Adj b)
+
+type USGr s = SGr s () ()
+
+sizeofMutableArray :: MutableArray s a -> Int
+sizeofMutableArray (MutableArray a) = I# (sizeofMutableArray# a)
+
+-- GraphM
+--
+instance (PrimMonad m, s ~ PrimState m) => GraphM m (SGr s) where
+  emptyM = emptyN defaultGraphSize
+  isEmptyM g = do {SGr (n,_,_) <- g; return (n==0)}
+  matchM v g = do g'@(SGr (n,a,m)) <- g
+                  case a!v of
+                    Nothing -> return (Nothing,g')
+                    Just (pr,l,su) ->
+                       do b <- readArray m v
+                          if b then return (Nothing,g') else
+                             do s  <- removeDel m su
+                                p' <- removeDel m pr
+                                let p = filter ((/=v).snd) p'
+                                writeArray m v True
+                                return (Just (p,v,l,s),SGr (n-1,a,m))
+  mkGraphM vs es = do m <- newArray n False
+                      return (SGr (n,pr,m))
+          where nod  = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs)
+                su   = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es)
+                pr   = accum addPre su (map (\(v,w,l)->(w,(l,v))) es)
+                bnds = (minimum vs',maximum vs')
+                vs'  = map fst vs
+                n    = length vs
+                addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s)
+                addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing"
+                addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s)
+                addPre Nothing _ = error "mkGraphM (SGr): addPre Nothing"
+  labNodesM g = do (SGr (_,a,m)) <- g
+                   let getLNode vs (_,Nothing)      = return vs
+                       getLNode vs (v,Just (_,l,_)) =
+                           do b <- readArray m v
+                              return (if b then vs else (v,l):vs)
+                   foldM getLNode [] (assocs a)
+
+defaultGraphSize :: Int
+defaultGraphSize = 100
+
+emptyN :: PrimMonad m => Int -> m (SGr (PrimState m) a b)
+emptyN n = do m <- newArray n False
+              return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m))
+
+----------------------------------------------------------------------
+-- UTILITIES
+----------------------------------------------------------------------
+
+-- | filter list (of successors\/predecessors) through a boolean ST array
+-- representing deleted marks
+removeDel :: PrimMonad m => MutableArray (PrimState m) Bool -> Adj b -> m (Adj b)
+removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)})
diff --git a/Data/Graph/Inductive/Monad/STArray.hs b/Data/Graph/Inductive/Monad/STArray.hs
index 9846a11..69dd827 100644
--- a/Data/Graph/Inductive/Monad/STArray.hs
+++ b/Data/Graph/Inductive/Monad/STArray.hs
@@ -10,104 +10,4 @@ module Data.Graph.Inductive.Monad.STArray(
     removeDel,
 ) where
 
-import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Monad
-
-import Control.Monad
-import Control.Monad.ST
-import Data.Array
-import Data.Array.ST
-import System.IO.Unsafe
-
-
-
-----------------------------------------------------------------------
--- GRAPH REPRESENTATION
-----------------------------------------------------------------------
-
-newtype SGr s a b = SGr (GraphRep s a b)
-
-type GraphRep s a b = (Int,Array Node (Context' a b),STArray s Node Bool)
-type Context'   a b = Maybe (Adj b,a,Adj b)
-
-type USGr s = SGr s () ()
-
-
-----------------------------------------------------------------------
--- CLASS INSTANCES
-----------------------------------------------------------------------
-
--- Show
---
-showGraph :: (Show a,Show b) => GraphRep RealWorld a b -> String
-showGraph (_,a,m) = concatMap showAdj (indices a)
-    where showAdj v | unsafeST (readArray m v) = ""
-                    | otherwise = case a!v of
-                        Nothing      -> ""
-                        Just (_,l,s) -> '\n':show v++":"++show l++"->"++show s'
-                          where s' = unsafeST (removeDel m s)
-
-unsafeST :: ST RealWorld a -> a
-unsafeST = unsafePerformIO . stToIO
-
--- | Please not that this instance is unsafe.
-instance (Show a,Show b) => Show (SGr RealWorld a b) where
-  show (SGr g) = showGraph g
-
-{-
-run :: Show (IO a) => IO a -> IO ()
-run x = seq x (print x)
--}
-
--- GraphM
---
-instance GraphM (ST s) (SGr s) where
-  emptyM = emptyN defaultGraphSize
-  isEmptyM g = do {SGr (n,_,_) <- g; return (n==0)}
-  matchM v g = do g'@(SGr (n,a,m)) <- g
-                  case a!v of
-                    Nothing -> return (Nothing,g')
-                    Just (pr,l,su) ->
-                       do b <- readArray m v
-                          if b then return (Nothing,g') else
-                             do s  <- removeDel m su
-                                p' <- removeDel m pr
-                                let p = filter ((/=v).snd) p'
-                                writeArray m v True
-                                return (Just (p,v,l,s),SGr (n-1,a,m))
-  mkGraphM vs es = do m <- newArray (1,n) False
-                      return (SGr (n,pr,m))
-          where nod  = array bnds (map (\(v,l)->(v,Just ([],l,[]))) vs)
-                su   = accum addSuc nod (map (\(v,w,l)->(v,(l,w))) es)
-                pr   = accum addPre su (map (\(v,w,l)->(w,(l,v))) es)
-                bnds = (minimum vs',maximum vs')
-                vs'  = map fst vs
-                n    = length vs
-                addSuc (Just (p,l',s)) (l,w) = Just (p,l',(l,w):s)
-                addSuc Nothing _ = error "mkGraphM (SGr): addSuc Nothing"
-                addPre (Just (p,l',s)) (l,w) = Just ((l,w):p,l',s)
-                addPre Nothing _ = error "mkGraphM (SGr): addPre Nothing"
-  labNodesM g = do (SGr (_,a,m)) <- g
-                   let getLNode vs (_,Nothing)      = return vs
-                       getLNode vs (v,Just (_,l,_)) =
-                           do b <- readArray m v
-                              return (if b then vs else (v,l):vs)
-                   foldM getLNode [] (assocs a)
-
-defaultGraphSize :: Int
-defaultGraphSize = 100
-
-emptyN :: Int -> ST s (SGr s a b)
-emptyN n = do m <- newArray (1,n) False
-              return (SGr (0,array (1,n) [(i,Nothing) | i <- [1..n]],m))
-
-----------------------------------------------------------------------
--- UTILITIES
-----------------------------------------------------------------------
-
-
-
--- | filter list (of successors\/predecessors) through a boolean ST array
--- representing deleted marks
-removeDel :: STArray s Node Bool -> Adj b -> ST s (Adj b)
-removeDel m = filterM (\(_,v)->do {b<-readArray m v;return (not b)})
+import Data.Graph.Inductive.Monad.Primitive
diff --git a/fgl.cabal b/fgl.cabal
index 5ab6d5f..c01b777 100644
--- a/fgl.cabal
+++ b/fgl.cabal
@@ -47,6 +47,7 @@ library {
         Data.Graph.Inductive.Tree,
         Data.Graph.Inductive.Monad.IOArray,
         Data.Graph.Inductive.Monad.STArray,
+        Data.Graph.Inductive.Monad.Primitive,
         Data.Graph.Inductive.Query.ArtPoint,
         Data.Graph.Inductive.Query.BCC,
         Data.Graph.Inductive.Query.BFS,
@@ -68,6 +69,7 @@ library {
     build-depends:    base < 5
                     , transformers
                     , array
+                    , primitive >= 0.6
 
     if flag(containers042)
         build-depends:    containers >= 0.4.2
@@ -75,7 +77,7 @@ library {
     else
         build-depends:    containers < 0.4.2
 
-    if impl(ghc >= 7.2) && impl(ghc < 7.6)
+    if impl(ghc >= 7.2)
         build-depends:
             ghc-prim