diff --git a/src/CFG/Graph.hs b/src/CFG/Graph.hs
index 83e65c2bce46b8ab0e447e03bfe3dea98462ec94..1c93ee4f17f1c28dc296a0955e3b2dcb4554c512 100644
--- a/src/CFG/Graph.hs
+++ b/src/CFG/Graph.hs
@@ -1,27 +1,17 @@
 {-# LANGUAGE DuplicateRecordFields #-}
 module CFG.Graph
-       ( CFG(..)
-       , P.Block(..)
-       , graphify
-       )where
+       ( graphify
+       ) where
 
 import Data.Graph
-import qualified CFG.Parser as P
 import Data.Text (Text)
 
-data CFG = CFG
-  { graph :: Graph
-  , getBlock :: Vertex -> (P.Block, Text, [Text])
-  , getVertex :: Text -> Maybe Vertex
-  }
+import CFG.Types
 
-instance Show CFG where
-  show = show . graph
-
-graphify :: P.Function -> CFG
+graphify :: Function -> CFG
 graphify function = CFG g ver2node key2vert
   where (g, ver2node, key2vert) = graphFromEdges $ graphList function
 
-graphList :: P.Function -> [(P.Block, Text, [Text])]
-graphList = map iter . P.blocks
-  where iter b = (b, P.name (b :: P.Block), P.successors b)
+graphList :: Function -> [(Block, Text, [Text])]
+graphList = map iter . funBlocks
+  where iter b = (b, blkName (b :: Block), blkSuccessors b)
diff --git a/src/CFG/IR.hs b/src/CFG/IR.hs
index 5022abfa4efd25377ca96c82df76945bfd56e9a0..21802bd4f7cd71d322fc975842fa8c5a4ad0889c 100644
--- a/src/CFG/IR.hs
+++ b/src/CFG/IR.hs
@@ -13,7 +13,7 @@ import Data.Text (Text)
 import Data.Graph
 import Data.Array
 
-import CFG.Graph
+import CFG.Types
 
 -- | Identifier, used for labels and function names
 type Ident = Text
@@ -35,7 +35,7 @@ flattenCFG :: Vertex -- ^ Start node
            -> [Instr]
 flattenCFG startNode cfg =
   Goto (vertexToIdent cfg startNode)
-  : concatMap (compileBlock cfg) (vertices $ graph cfg)
+  : concatMap (compileBlock cfg) (vertices $ cfgGraph cfg)
   -- TODO Better (unambiguous) name for the out label
   ++ [Label "out"]
 
@@ -48,7 +48,7 @@ compileBlock cfg vertex =
   where ident = vertexToIdent cfg vertex
         call = [] -- TODO
 
-        gotoSuccs = case graph cfg ! vertex of
+        gotoSuccs = case cfgGraph cfg ! vertex of
           [] -> Goto "out" -- no successors
           [successor] -> Goto (vertexToIdent cfg successor)
           [left, right] -> IfThanElse vertex
@@ -59,4 +59,4 @@ compileBlock cfg vertex =
 
 vertexToIdent :: CFG -> Vertex -> Ident
 vertexToIdent cfg vertex = key
-  where (_, key, _) = getBlock cfg vertex
+  where (_, key, _) = cfgGetBlock cfg vertex
diff --git a/src/CFG/Parser.hs b/src/CFG/Parser.hs
index 424f8b4d053b8f32e317461c30828123be208a18..fbc03579fc8c7f79dd8d2cb9cc1a4fac8a0548ab 100644
--- a/src/CFG/Parser.hs
+++ b/src/CFG/Parser.hs
@@ -2,10 +2,6 @@
 module CFG.Parser
        ( parseFile
        , file
-       , Function(..)
-       , FunctionKind(..)
-       , Block(..)
-       , CallInfo(..)
        ) where
 
 import Text.Megaparsec
@@ -13,31 +9,11 @@ import Text.Megaparsec.Text
 import Data.Text (Text)
 import qualified Data.Text as T
 
+import CFG.Types
+
 parseFile :: FilePath -> Text -> Either (ParseError Char Dec) [Function]
 parseFile = parse file
 
-data Function = Function
-  { kind :: FunctionKind
-  , name :: Text
-  , subtask :: Text
-  , entryNode :: Text
-  , blocks :: [Block]
-  }
-  deriving (Show, Eq)
-
-data FunctionKind = KindFunction | KindSubtask
-  deriving (Show, Eq)
-
-data Block = Block
-  { name :: Text
-  , successors :: [Text]
-  , callInfo :: Maybe CallInfo
-  }
-  deriving (Show, Eq)
-
-data CallInfo = FunctionCall Text | SystemCall Text
-  deriving (Show, Eq)
-
 file :: Parser [Function]
 file = many function
 
diff --git a/src/CFG/Types.hs b/src/CFG/Types.hs
new file mode 100644
index 0000000000000000000000000000000000000000..2c77526c4abe144612844b6592123045ad1bb3ad
--- /dev/null
+++ b/src/CFG/Types.hs
@@ -0,0 +1,35 @@
+module CFG.Types where
+
+import Data.Text (Text)
+import Data.Graph
+
+data Function = Function
+  { funKind :: FunctionKind
+  , funName :: Text
+  , funSubtask :: Text
+  , funEntryNode :: Text
+  , funBlocks :: [Block]
+  }
+  deriving (Show, Eq)
+
+data FunctionKind = KindFunction | KindSubtask
+  deriving (Show, Eq)
+
+data Block = Block
+  { blkName :: Text
+  , blkSuccessors :: [Text]
+  , blkCallInfo :: Maybe CallInfo
+  }
+  deriving (Show, Eq)
+
+data CallInfo = FunctionCall Text | SystemCall Text
+  deriving (Show, Eq)
+
+data CFG = CFG
+  { cfgGraph :: Graph
+  , cfgGetBlock :: Vertex -> (Block, Text, [Text])
+  , cfgGetVertex :: Text -> Maybe Vertex
+  }
+
+instance Show CFG where
+  show = show . cfgGraph
diff --git a/stub-generator.cabal b/stub-generator.cabal
index 2480222ff20e077c3fc941bd347b49f8997671e6..3abef82421401c4d4fcc0a2bec97be20969eb567 100644
--- a/stub-generator.cabal
+++ b/stub-generator.cabal
@@ -17,6 +17,7 @@ library
                      , CFG.Graph
                      , CFG.IR
                      , CFG.C
+                     , CFG.Types
   hs-source-dirs:      src
   build-depends:       base >=4.8 && <4.10
                      , megaparsec >= 5 && <5.1