diff --git a/Language/Haskell/TH/TypeGraph.hs b/Language/Haskell/TH/TypeGraph.hs
--- a/Language/Haskell/TH/TypeGraph.hs
+++ b/Language/Haskell/TH/TypeGraph.hs
@@ -12,7 +12,7 @@
 import Language.Haskell.TH.TypeGraph.Core (FieldType(FieldType, fPos, fNameAndType), fName, fType, typeArity, pprint')
 import Language.Haskell.TH.TypeGraph.Expand (Expanded(markExpanded), runExpanded, E(E))
 import Language.Haskell.TH.TypeGraph.Graph (GraphEdges, graphFromMap, cut, cutM, isolate, isolateM, dissolve, dissolveM)
-import Language.Haskell.TH.TypeGraph.Hints (VertexHint(Normal, Hidden, Sink, Divert, Extra))
+import Language.Haskell.TH.TypeGraph.Hints (VertexHint(Normal, Divert, Extra))
 import Language.Haskell.TH.TypeGraph.Info (TypeGraphInfo, fields, hints, infoMap, synonyms, typeSet,
                                            emptyTypeGraphInfo, typeGraphInfo)
 import Language.Haskell.TH.TypeGraph.Monad (vertex, allVertices, typeGraphEdges, simpleEdges, simpleVertex)
diff --git a/Language/Haskell/TH/TypeGraph/Core.hs b/Language/Haskell/TH/TypeGraph/Core.hs
--- a/Language/Haskell/TH/TypeGraph/Core.hs
+++ b/Language/Haskell/TH/TypeGraph/Core.hs
@@ -18,8 +18,10 @@
     , typeArity
     -- * Pretty print without extra whitespace
     , pprint'
+    , unlifted
     ) where
 
+import Control.Applicative ((<$>), (<*>))
 import Data.Generics (Data, everywhere, mkT)
 import Data.Map as Map (Map, fromList, toList)
 import Data.Set as Set (Set, fromList, toList)
@@ -143,3 +145,32 @@
 
 instance Lift (E Type) where
     lift etype = [|markExpanded $(lift (runExpanded etype))|]
+
+-- | Does the type or the declaration to which it refers contain a
+-- primitive (aka unlifted) type?  This will traverse down any 'Dec'
+-- to the named types, and then check whether any of their 'Info'
+-- records are 'PrimTyConI' values.
+class IsUnlifted t where
+    unlifted :: Quasi m => t -> m Bool
+
+instance IsUnlifted Dec where
+    unlifted (DataD _ _ _ cons _) = or <$> mapM unlifted cons
+    unlifted (NewtypeD _ _ _ con _) = unlifted con
+    unlifted (TySynD _ _ typ) = unlifted typ
+    unlifted _ = return False
+
+instance IsUnlifted Con where
+    unlifted (ForallC _ _ con) = unlifted con
+    unlifted (NormalC _ ts) = or <$> mapM (unlifted . snd) ts
+    unlifted (RecC _ ts) = or <$> mapM (\ (_, _, t) -> unlifted t) ts
+    unlifted (InfixC t1 _ t2) = or <$> mapM (unlifted . snd) [t1, t2]
+
+instance IsUnlifted Type where
+    unlifted (ForallT _ _ typ) = unlifted typ
+    unlifted (ConT name) = qReify name >>= unlifted
+    unlifted (AppT t1 t2) = (||) <$> unlifted t1 <*> unlifted t2
+    unlifted _ = return False
+
+instance IsUnlifted Info where
+    unlifted (PrimTyConI _ _ _) = return True
+    unlifted _ = return False -- traversal stops here
diff --git a/Language/Haskell/TH/TypeGraph/Hints.hs b/Language/Haskell/TH/TypeGraph/Hints.hs
--- a/Language/Haskell/TH/TypeGraph/Hints.hs
+++ b/Language/Haskell/TH/TypeGraph/Hints.hs
@@ -27,8 +27,6 @@
 -- alterations in the type graph from the usual default.
 data VertexHint
     = Normal          -- ^ normal case
-    | Hidden          -- ^ don't create this vertex, no in or out edges
-    | Sink            -- ^ out degree zero - don't create any out edges
     | Divert Type     -- ^ replace all out edges with an edge to an alternate type
     | Extra Type      -- ^ add an extra out edge to the given type
     deriving (Eq, Ord, Show)
@@ -38,15 +36,11 @@
 
 instance Lift VertexHint where
     lift Normal = [|Normal|]
-    lift Hidden = [|Hidden|]
-    lift Sink = [|Sink|]
     lift (Divert x) = [|Divert $(lift x)|]
     lift (Extra x) = [|Extra $(lift x)|]
 
 instance Ppr VertexHint where
     ppr Normal = ptext "Normal"
-    ppr Hidden = ptext "Hidden"
-    ppr Sink = ptext "Sink"
     ppr (Divert x) = hcat [ptext "Divert (", ppr x, ptext ")"]
     ppr (Extra x) = hcat [ptext "Extra (", ppr x, ptext ")"]
 
diff --git a/Language/Haskell/TH/TypeGraph/Monad.hs b/Language/Haskell/TH/TypeGraph/Monad.hs
--- a/Language/Haskell/TH/TypeGraph/Monad.hs
+++ b/Language/Haskell/TH/TypeGraph/Monad.hs
@@ -30,30 +30,22 @@
 import Control.Monad.Reader (MonadReader)
 import Control.Monad.State (execStateT, modify, StateT)
 import Data.Default (Default(def))
+import Data.Foldable
 import Data.List as List (map)
-import Data.Map as Map ((!), findWithDefault, map, mapKeys, mapWithKey, alter)
-import Data.Set as Set (delete, empty, insert, map, Set, singleton)
+import Data.Map as Map ((!), alter, findWithDefault, map, mapKeysWith, mapWithKey)
+import Data.Monoid (Monoid, (<>))
+import Data.Set as Set (delete, empty, insert, map, Set, singleton, union)
 import Language.Haskell.Exts.Syntax ()
 import Language.Haskell.TH -- (Con, Dec, nameBase, Type)
 import Language.Haskell.TH.TypeGraph.Core (Field)
 import Language.Haskell.TH.TypeGraph.Expand (E(E), expandType)
-import Language.Haskell.TH.TypeGraph.Graph (cut, GraphEdges)
-import Language.Haskell.TH.TypeGraph.Hints (HasVertexHints(hasVertexHints), VertexHint(..))
-import Language.Haskell.TH.TypeGraph.Info (TypeGraphInfo, fields, hints, infoMap, synonyms, typeSet)
-import Language.Haskell.TH.TypeGraph.Vertex (TypeGraphVertex(..), etype, field, typeNames)
+import Language.Haskell.TH.TypeGraph.Graph (GraphEdges)
+import Language.Haskell.TH.TypeGraph.Info (TypeGraphInfo, fields, infoMap, synonyms, typeSet)
+import Language.Haskell.TH.TypeGraph.Vertex (TypeGraphVertex(..), etype, field)
 import Language.Haskell.TH.Desugar as DS (DsMonad)
 import Language.Haskell.TH.Instances ()
 import Prelude hiding (foldr, mapM_, null)
 
-import Data.Foldable (mapM_)
-#if MIN_VERSION_base(4,8,0)
-import Data.Foldable (null)
-#else
-import Data.Foldable (Foldable, foldr)
-null :: Foldable t => t a -> Bool
-null = foldr (\_ _ -> False) True
-#endif
-
 allVertices :: (Functor m, DsMonad m, MonadReader (TypeGraphInfo hint) m) =>
                Maybe Field -> E Type -> m (Set TypeGraphVertex)
 allVertices (Just fld) etyp = singleton <$> vertex (Just fld) etyp
@@ -83,56 +75,13 @@
 fieldVertex :: MonadReader (TypeGraphInfo hint) m => E Type -> Field -> m TypeGraphVertex
 fieldVertex etyp fld' = typeVertex etyp >>= \v -> return $ v {_field = Just fld'}
 
--- | Start with the type graph on the known types, and build a new
--- graph which incorporates the information from the hints.
-typeGraphEdges :: forall m hint. (DsMonad m, Default hint, Eq hint, HasVertexHints hint, MonadReader (TypeGraphInfo hint) m) =>
-                  m (GraphEdges hint TypeGraphVertex)
-typeGraphEdges = do
-  findEdges {->>= t1-} >>= execStateT (view hints >>= mapM doHint) {->>= t2-}
-    where
-      doHint :: (Maybe Field, Name, hint) -> StateT (GraphEdges hint TypeGraphVertex) m ()
-      doHint (fld, tname, hint) = hasVertexHints hint >>= mapM_ (\vh -> expandType (ConT tname) >>= allVertices fld >>= mapM_ (\v -> {-t3 v vh >>-} doVertexHint v vh))
-
-      doVertexHint :: TypeGraphVertex -> VertexHint -> StateT (GraphEdges hint TypeGraphVertex) m ()
-      doVertexHint _ Normal = return ()
-      doVertexHint v Sink =
-        modify $ Map.alter (alterFn (const Set.empty)) v
-      doVertexHint v Hidden =
-        modify $ cut (singleton v)
-      -- Replace all out edges with a single edge to typ'
-      doVertexHint v (Divert typ') = do
-        v' <- expandType typ' >>= vertex Nothing
-#if 0
-        modify $ Map.alter (alterFn (const (singleton v'))) v
-#else
-        -- This is here because we want a path to ReportIntendedUse even
-        -- though there is a substitution of String on Maybe ReportIntendedUse.
-        -- I'm going to try to remove the Maybe from that substitution.
-        case (null $ typeNames v) of
-          False -> modify $ Map.alter (alterFn (const (singleton v'))) v
-          True -> modify $ Map.alter (alterFn (Set.insert v')) v
-#endif
-      doVertexHint v (Extra typ') = do
-        v' <- expandType typ' >>= vertex Nothing
-        modify $ Map.alter (alterFn (Set.insert v')) v
-
-      -- t1 x = trace ("before hints:\n" ++ pprint x) (return x)
-      -- t2 x = trace ("after hints:\n" ++ pprint x) (return x)
-      -- t3 v x = trace ("doVertexHint " ++ pprint' v ++ ": " ++ pprint x) (return ())
-
--- | build the function argument of Map.alter for the GraphEdges map.
-alterFn :: Default hint => (Set TypeGraphVertex -> Set TypeGraphVertex) -> Maybe (hint, Set TypeGraphVertex) -> Maybe (hint, Set TypeGraphVertex)
-alterFn setf (Just (hint, s)) = Just (hint, setf s)
-alterFn setf Nothing | null (setf Set.empty) = Nothing
-alterFn setf Nothing = Just (def, setf Set.empty)
-
 -- | Given the discovered set of types and maps of type synonyms and
 -- fields, build and return the GraphEdges relation on TypeGraphVertex.
 -- This is not a recursive function, it stops when it reaches the field
 -- types.
-findEdges :: forall hint m. (DsMonad m, Functor m, Default hint, MonadReader (TypeGraphInfo hint) m) =>
-             m (GraphEdges hint TypeGraphVertex)
-findEdges = do
+typeGraphEdges :: forall hint m. (DsMonad m, Functor m, Default hint, MonadReader (TypeGraphInfo hint) m) =>
+                  m (GraphEdges hint TypeGraphVertex)
+typeGraphEdges = do
   execStateT (view typeSet >>= \ts -> mapM_ (\t -> expandType t >>= doType) ts) mempty
     where
       doType :: E Type -> StateT (GraphEdges hint TypeGraphVertex) m ()
@@ -190,10 +139,12 @@
 -- | Simplify a graph by throwing away the field information in each
 -- node.  This means the nodes only contain the fully expanded Type
 -- value (and any type synonyms.)
-simpleEdges :: GraphEdges hint TypeGraphVertex -> GraphEdges hint TypeGraphVertex
+simpleEdges :: Monoid hint => GraphEdges hint TypeGraphVertex -> GraphEdges hint TypeGraphVertex
 simpleEdges = Map.mapWithKey (\v (n, s) -> (n, Set.delete v s)) .    -- delete any self edges
-              Map.mapKeys simpleVertex .               -- simplify each vertex
+              Map.mapKeysWith combine simpleVertex .   -- simplify each vertex
               Map.map (over _2 (Set.map simpleVertex)) -- simplify the out edges
+    where
+      combine (n1, s1) (n2, s2) = (n1 <> n2, Set.union s1 s2)
 
 simpleVertex :: TypeGraphVertex -> TypeGraphVertex
 simpleVertex v = v {_field = Nothing}
diff --git a/th-typegraph.cabal b/th-typegraph.cabal
--- a/th-typegraph.cabal
+++ b/th-typegraph.cabal
@@ -1,5 +1,5 @@
 name:               th-typegraph
-version:            0.17
+version:            0.17.1
 cabal-version:      >= 1.10
 build-type:         Simple
 license:            BSD3