diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for bytestring-xml
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2016, Pepe Iborra
+
+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 Pepe Iborra 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Test.hs b/Test.hs
new file mode 100644
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,179 @@
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE OverloadedStrings, DisambiguateRecordFields #-}
+
+import qualified Text.XML.Hexml as Hexml
+import Control.Monad
+import Data.Char
+import Data.Foldable
+import Data.List (sort)
+import Data.Monoid
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Storable as V
+import System.Process (callCommand)
+import System.FilePath
+import Text.Printf
+
+import Config
+import Text.Xml.Tiny
+import Text.Xml.Tiny.Internal(Node(..), Attribute(..), ParseDetails(ParseDetails), AttributeParseDetails(..), Slice)
+import qualified Text.Xml.Tiny.Internal as Slice
+
+examples :: [(Bool, BS.ByteString)]
+examples =
+    [(True,"<hello>world</hello>")
+    ,(True,"<hello/>")
+    ,(True, "<test id='bob'>here<extra/>there</test>")
+    ,(True, "<test /><close />")
+    ,(True, "<test /><!-- comment > --><close />")
+    ,(True, "<test id=\"bob value\" another-attr=\"test with <\">here </test> more text at the end<close />")
+    ,(False, "<test></more>")
+    ,(False, "<test")
+    ,(True, "<?xml version=\"1.1\"?>\n<greeting>Hello, world!</greeting>")
+    ]
+
+xmlFiles = [ "mail", "benchmark" ]
+
+main = do
+    forM_ examples $ \(parses,src) -> do
+         case parse src of
+            Left err ->
+              when parses $ fail ("Unexpected failure on " ++ BS.unpack src ++ ": " ++ show err)
+            Right doc -> do
+              unless parses $ fail ( "Unexpected success on " ++ BS.unpack src)
+              print src
+              print doc
+
+    let Right doc = parse "<test id=\"1\" extra=\"2\" />\n<test id=\"2\" /><b><test id=\"3\" /></b><test id=\"4\" /><test />"
+    map name (children doc) === ["test","test","b","test","test"]
+    location (children doc !! 2) === (2,16)
+    length (childrenBy doc "test") === 4
+    length (childrenBy doc "b") === 1
+    length (childrenBy doc "extra") === 0
+    attributes (head $ children doc) === [Attribute "id" "1", Attribute "extra" "2"]
+    map (`attributeBy` "id") (childrenBy doc "test") === map (fmap (Attribute "id")) [Just "1", Just "2", Just "4", Nothing]
+
+    Right _ <- return $ parse $ "<test " <> BS.unwords [BS.pack $ "x" ++ show i ++ "='value'" | i <- [1..10000]] <> " />"
+    Right _ <- return $ parse $ BS.unlines $ replicate 10000 "<test x='value' />"
+
+    let attrs = ["usd:jpy","test","extra","more","stuff","jpy:usd","xxx","xxxx"]
+    Right doc <- return $ parse $ "<test " <> BS.unwords [x <> "='" <> x <> "'" | x <- attrs] <> ">middle</test>"
+    [c] <- return $ childrenBy doc "test"
+
+    forM_ attrs $ \a -> attributeBy c a === Just (Attribute a a)
+    forM_ ["missing","gone","nothing"] $ \a -> attributeBy c a === Nothing
+
+    forM_ xmlFiles $ \name -> do
+      putStrLn ""
+
+      let path   = "xml" </> name <.> "xml"
+      let pathGz = path <.> ".bz2"
+      callCommand $ "bunzip2 -f -k " ++ pathGz
+      xml <- BS.readFile path
+      let us = either (error $ "failed to parse: " ++ path) id $ parse xml
+
+      checkStructure us
+
+      let hexml = either (error $ "Hexml failed to parse: " ++ path ) id $ Hexml.parse xml
+      testEq us hexml
+
+    putStrLn "\nSuccess"
+
+checkFind :: Node -> IO ()
+checkFind n = do
+    forM_ (attributes n) $ \a -> attributeBy n (attributeName a) === Just a
+    attributeBy n "xxx" === (Nothing :: Maybe Attribute)
+    let cs = children n
+    forM_ ("xxx":map name cs) $ \c ->
+        map outer (filter ((==) c . name) cs) === map outer (childrenBy n c)
+    mapM_ checkFind $ children n
+
+pairs f (a:b:rest) = f a b && pairs f (b:rest)
+pairs f _ = True
+
+checkStructure :: Config => Node -> IO ()
+checkStructure n = checkNode [] n where
+  checkNode path n@Node{attributesV, slices=ParseDetails{attributes}} = do
+    let nn = children n
+    unless (sorted nn) $ fail "not sorted"
+    unless (pairs (nonOverlapping path) nn) $ fail "overlapping children nodes"
+    unless (pairs nonOverlappingA (Slice.vector attributes attributesV)) $ fail "overlapping attributes"
+    putChar '.'
+    forM_ nn $ \n' -> checkNode (name n : path) n'
+
+  nonOverlapping :: Config => [BS.ByteString] -> Node -> Node -> Bool
+  nonOverlapping path n1@Node{slices=ParseDetails{outer=o1}} n2@Node{slices=ParseDetails{outer=o2}} =
+    nonOverlappingS o1 o2
+    || error (printf "%s Overlapping nodes: %s(%s) %s(%s)" (show path) (show$ outer n1) (show $ location n1) (show$ outer n2) (show$ location n2))
+
+  nonOverlappingA :: Config => AttributeParseDetails -> AttributeParseDetails -> Bool
+  nonOverlappingA a1@(AttributeParseDetails n v) a2@(AttributeParseDetails n' v') =
+    let slices = [n,v,n',v']
+    in  and [ s >= s' || nonOverlappingS s s'
+              | s <- slices, s' <- slices]
+        || error (printf "overlapping attributes" (show a1) (show a2))
+
+  nonOverlappingS :: Config => Slice -> Slice -> Bool
+  nonOverlappingS s1 s2 =    Slice.end s1 <= Slice.start s2
+                          || Slice.end s2 <= Slice.start s1
+                          -- || error (printf "Overlapping slices: %s, %s" (show s1) (show s2))
+
+  sorted nn =
+    let outers = map (Slice.start.Slice.outer.slices) nn
+    in sort outers == outers
+    || error ("Internal error - nodes not sorted: " ++
+              show [ (name n, Slice.start(Slice.outer(slices n))) | n <- nn])
+
+class (Show a, Show b) => TestEq a b where testEq :: a -> b -> IO ()
+
+(===) :: Config => TestEq a a => a -> a -> IO ()
+(===) = testEq
+
+instance (Show a, Eq a) => TestEq a a where
+  a `testEq` b = if a == b then putChar '.' else error $ "mismatch, " ++ show a ++ " /= " ++ show b
+
+instance TestEq Node Hexml.Node where
+  testEq n n' = do
+    name n `testEq` Hexml.name n'
+    test "attributes" (attributes n) (Hexml.attributes n')
+    test "contents"   (contents n)   (Hexml.contents n')
+
+   where
+     test (msg :: String) aa bb
+       | length aa == length bb = zipWithM_ testEq aa bb
+       | otherwise = error$ printf "Length of %s does not match (%d /= %d):\n%s\n---------------\n%s" msg (length aa) (length bb) (show aa) (show bb)
+
+instance TestEq Attribute Hexml.Attribute where
+    Attribute n v `testEq` Hexml.Attribute n' v' = do
+      n `testEq` n'
+      v `testEq` v'
+
+instance (Show a, Show b, TestEq a a', TestEq b b') => TestEq (Either a b) (Either a' b') where
+  Left  e `testEq` Left e'  = e `testEq` e'
+  Right x `testEq` Right x' = x `testEq` x'
+  testEq a b = error $ printf "mismatch in children: %s /= %s" (show a) (show b)
+
+debugShow :: Node -> String
+debugShow n =
+    unlines $
+         "Nodes buffer: "
+       : [ "  " ++ show n | n <- V.toList $ nodesV n]
+       ++ showNodeContents (Right n)
+     where
+       showNodeContents :: Either BS.ByteString Node -> [String]
+       showNodeContents (Right n) =
+          [ "Node contents:"
+          , "  name: " ++ show (name n)
+          , "  slices: " ++ show (slices n)
+          , "  attributes: " ++ (show $ attributes n)
+          , "  contents: "
+          ] ++
+          [ "    " ++ l | n' <- contents n, l <- showNodeContents n']
+       showNodeContents (Left txt) =
+          [ "Text content: " ++ BS.unpack txt ]
diff --git a/Validate.hs b/Validate.hs
new file mode 100644
--- /dev/null
+++ b/Validate.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators     #-}
+
+import Text.Xml.Tiny
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+import Options.Generic
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Environment
+
+import Text.Printf
+
+data Options =
+  Options { reprint :: Bool <?> "Reprint the XML document" }
+  deriving (Generic, Show, ParseRecord)
+
+data Args = Args Options [String] deriving (Generic, Show)
+
+instance ParseRecord Args where parseRecord = Args <$> parseRecord <*> parseRecord
+
+main = do
+  Args args paths <- getRecord "Validate XML"
+  hSetBuffering stdout LineBuffering
+  forM_ paths $ \p -> do
+    contents <- BS.readFile p
+    case parse contents of
+      Left e -> print e
+      Right node -> do
+        putStrLn "OK"
+        when (unHelpful $ reprint args) $ do
+          let destPath = p <.> "reprint"
+          existsAlready <- doesFileExist destPath
+          if existsAlready
+            then putStrLn $ "Overwriting " ++ destPath
+            else putStrLn $ "Reprinting to " ++ destPath
+          BS.writeFile destPath (rerender node)
diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE ConstraintKinds, KindSignatures, ImplicitParams, CPP #-}
+module Config where
+
+import GHC.Exts
+import qualified GHC.Stack
+import qualified Debug.Trace
+
+trace :: String -> a -> a
+#ifdef TRACE
+trace msg = Debug.Trace.trace msg
+#else
+trace msg x = x
+#endif
+{-# INLINE trace #-}
+
+#if __GLASGOW_HASKELL__ < 800
+type HasCallStack = (?callStack :: GHC.Stack.CallStack)
+#else
+type HasCallStack = GHC.Stack.HasCallStack
+#endif
+
+#ifdef STACKTRACES
+type Config = HasCallStack
+#else
+type Config = (() :: Constraint)
+#endif
+
diff --git a/src/Data/VectorBuilder/Storable.hs b/src/Data/VectorBuilder/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/VectorBuilder/Storable.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE CPP #-}
+module Data.VectorBuilder.Storable
+  (VectorBuilder, new, indexFromEnd, insert, push, pop, updateStackElt, getCount, getStackCount, finalize, unsafeToMVector, peek
+  ) where
+
+import Control.Exception (assert)
+import Control.Monad
+import Control.Monad.ST.Unsafe
+import Control.Monad.Primitive
+import Data.Int
+import Data.Primitive.MutVar
+import qualified Data.Vector.Storable as S
+import qualified Data.Vector.Storable.Mutable as SM
+import qualified Data.Vector.Generic.Mutable as M
+--import qualified Data.Vector.Storable.Mutable as M
+import qualified Data.Vector.Unboxed.Mutable  as U
+import Foreign (Storable(sizeOf), Ptr, plusPtr)
+import Foreign.ForeignPtr
+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
+import Config
+import Text.Printf
+
+default (Int, Double)
+
+data VectorBuilder s a =
+  VectorBuilder
+    {
+      -- We use an unboxed vector instead of a MutVar, which would have to be boxed
+      --  (writing to MutVar is slow because of GC book keeping)
+      next  :: {-# UNPACK #-} !(U.MVector s Int32)  -- ^ The next free index in the mutable store
+      -- The MVector is in a MutVar because grow is not in-place
+    , store :: {-# UNPACK #-} !(MutVar s (S.MVector s a))    -- ^ The mutable store
+    }
+
+readU  :: (Config, _) => _
+writeU :: (Config, _) => _
+writeM :: (Config, _) => _
+readM :: (Config, _) => _
+copyM :: (Config, _) => _
+sliceM :: (Config, _) => _
+getCount, getStackCount :: Config => PrimMonad m => VectorBuilder(PrimState m) a -> m Int32
+
+#ifdef ENABLE_VECTOR_CHECKS
+readU  a = U.read  a
+writeU a = U.write a
+writeM a ix = M.write a (fromIntegral ix)
+readM  a ix = M.read a  (fromIntegral ix)
+copyM  a = M.copy a
+sliceM a b = M.slice (fromIntegral a) (fromIntegral b)
+#else
+readU  a = U.unsafeRead  a
+writeU a = U.unsafeWrite a
+writeM a !ix = M.unsafeWrite a (fromIntegral ix)
+readM  a !ix = M.unsafeRead a (fromIntegral ix)
+copyM  a = M.unsafeCopy a
+sliceM a b = M.unsafeSlice (fromIntegral a) (fromIntegral b)
+#endif
+
+-- | Yields the number of elements stored in the buffer
+getCount l = readU (next l) 0
+
+-- | Yields the number of elements in the stack
+getStackCount l = readU  (next l) 1
+
+-- | Ensure that there is sufficient space
+request :: (Config, Storable a, PrimMonad m) => Int32 -> VectorBuilder (PrimState m) a -> m ()
+request !n VectorBuilder{next,store} = do
+  frontCount <- readU  (next) 0
+  backCount  <- readU  (next) 1
+  assert (frontCount >= 0) $ return ()
+  assert (backCount >= 0) $ return ()
+  a <- readMutVar (store)
+  let !len = M.length a
+  unless (frontCount + backCount + n < fromIntegral len) $ do
+        return ()
+        a' <- newVectorAllocatedExternally(len*2)
+        copyM (sliceM 0 frontCount a') (sliceM 0 frontCount a)
+        copyM (sliceM (2 * fromIntegral len - backCount) backCount a') (sliceM (fromIntegral len - backCount) backCount a)
+        writeMutVar (store ) a'
+{-# INLINE request #-}
+
+-- | Inserts an element at the next free position in the vector and returns the index
+insert :: (Config, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> a -> m ()
+insert l@VectorBuilder{next,store} v = do
+  request 1 l
+  nextI <- readU  (next ) 0
+  writeU (next ) 0 (nextI + 1)
+  a <- readMutVar (store )
+  writeM a nextI v
+{-# INLINE insert #-}
+
+-- | Push an element into a stack-like temporary storage. Returns the index from the back
+push :: (Config, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> a -> m Int32
+push l@VectorBuilder{next,store} !v = do
+  request 1 l
+  stackCount <- readU  (next) 1
+  writeU (next) 1 (stackCount + 1)
+  assert (stackCount >= 0) $ return ()
+  a <- readMutVar (store)
+  let ix = (fromIntegral $ M.length a) - stackCount - 1
+  writeM a ix v
+  return stackCount
+{-# INLINE push #-}
+
+-- | Peek into the temporary stack
+peek :: Config => (Storable a, PrimMonad m, Storable a, Num n, Integral n, Ord n) => VectorBuilder (PrimState m) a -> n -> m a
+peek VectorBuilder{next, store} n = do
+  backCount <- readU next 1
+  assert(fromIntegral backCount > n) $ return ()
+  a <- readMutVar store
+  readM a (M.length a - fromIntegral backCount - 1 + fromIntegral n)
+
+updateStackElt :: Config => (Storable a, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> Int32 -> (a -> a) -> m ()
+updateStackElt VectorBuilder{store} i f = do
+  arr <- readMutVar store
+  let ix = (M.length arr - fromIntegral i - 1)
+  a <- readM arr ix
+  writeM arr ix (f a)
+{-# INLINE updateStackElt #-}
+
+indexFromEnd :: forall a m . Config => (Storable a, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> Int32 -> m (Ptr a)
+indexFromEnd VectorBuilder{store} i = do
+  a <- readMutVar store
+  let (fptr, _) = SM.unsafeToForeignPtr0 a
+  let ptr = unsafeForeignPtrToPtr fptr
+  let s = sizeOf(undefined :: a)
+  return $ plusPtr ptr ((M.length a - fromIntegral i -  1) * s)
+
+-- | Yield a short lived reference to the underlying foreign vector.
+--   Note that Insert and Push may allocate a new underlying vector.
+unsafeToMVector l = readMutVar (store l)
+
+-- | Pop elements out of the temporary stack and append into the main buffer
+pop :: Config => (Storable a, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> Int32 -> m ()
+pop l@VectorBuilder{next, store} n = do
+  request n l
+  backCount <- readU next 1
+  frontCount <- readU next 0
+  assert(backCount >= n) $ return ()
+  writeU next 0 (frontCount +  n)
+  writeU next 1 (backCount - n)
+  a <- readMutVar store
+  let !l = M.length a
+  let !first = fromIntegral l - backCount
+  forM_ [1..n] $ \i ->
+    let from = frontCount - 1 + i
+        to   = first+n-i
+    in when (from /= to) $
+        copyM (sliceM from 1 a) (sliceM to 1 a)
+{-# INLINE pop #-}
+
+-- | Extracts an immutable vector. The VectorBuilder can no longer be used after this
+finalize :: (Config, PrimMonad m, Storable a) => VectorBuilder (PrimState m) a -> m (S.Vector a)
+finalize l = trace "VectorBuilder.finalize" $ do
+  v <- readMutVar (store l)
+  frontCount <- readU (next l) 0
+  S.unsafeFreeze (sliceM 0 frontCount v)
+
+new :: (Config, PrimMonad m, Storable a) => Int -> m (VectorBuilder (PrimState m) a)
+new initialSize = do
+  next <- U.unsafeNew 2
+  writeU next 0 0
+  writeU next 1 0
+  store <- newVectorAllocatedExternally initialSize
+  storeRef <- newMutVar store
+  return (VectorBuilder next storeRef)
+
+newVectorAllocatedExternally size = (`SM.unsafeFromForeignPtr0` size) <$> primToPrim (unsafeIOToST $ mallocForeignPtrArray size)
diff --git a/src/Text/Xml/Tiny.hs b/src/Text/Xml/Tiny.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Xml/Tiny.hs
@@ -0,0 +1,124 @@
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | This module contains functions for parsing an XML document and deconstructing the AST.
+module Text.Xml.Tiny
+  ( Node, name, inner, outer, contents, location
+  , Attribute(..)
+  , parse
+  , children, childrenBy
+  , attributes, attributeBy
+  , SrcLoc(..)
+  , Error(..)
+  , ErrorType(..)
+  , rerender
+  ) where
+
+import Control.Exception
+import Text.Xml.Tiny.Internal (Node(..), Attribute(..), ParseDetails(ParseDetails), AttributeParseDetails(..), Error(..), ErrorType(..), SrcLoc(..))
+import qualified Text.Xml.Tiny.Internal as Slice
+import qualified Text.Xml.Tiny.Internal.Parser as Internal
+import Data.ByteString.Internal (ByteString(..))
+import qualified Data.ByteString.Char8 as BS
+import Data.Char
+import Data.Int
+import Data.Maybe (listToMaybe)
+import Data.Monoid
+import Config
+import Text.Printf
+
+-- | Parse an XML bytestring, returning a root node with name "" and the content AST, or an error.
+--   Note that the returned AST references the input bytestring and will therefore keep it alive.
+parse :: Config => ByteString -> Either Error Node
+parse bs =
+  case Internal.parse bs of
+    Left e -> Left e
+    Right (attV, nV, slices) -> Right $ Node attV nV bs slices
+
+instance Show Node where
+  -- | Returns a simplified rendering of the node.
+  --   If you want a full rendering, use `outer`
+  show n =
+    case children n of
+      [] -> printf "<%s%s/>" nameN attrs
+      _  -> printf "<%s%s>...</%s>" nameN attrs nameN
+   where
+    nameN = BS.unpack $ name n
+    attrs = unwords [ BS.unpack n <> "=" <> BS.unpack v | Attribute n v <- attributes n]
+
+name, inner, outer :: Config => Node -> ByteString
+-- | The tag name
+name  Node{source, slices = ParseDetails{..}} = Slice.render name source
+-- | The content of the tag, excluding the tag itself
+inner Node{source, slices = ParseDetails{..}} = Slice.render inner source
+-- | The contents of the tag, including the tag itself
+outer Node{source, slices = ParseDetails{..}} = Slice.render outer source
+-- | The attributes in the tag, if any.
+attributes :: Config => Node -> [Attribute]
+attributes Node{attributesV, source, slices = ParseDetails{attributes}} =
+  [ Attribute (Slice.render n source) (Slice.render v source)
+    | AttributeParseDetails n v <- Slice.vector attributes attributesV ]
+
+-- | Get the slices of a node, including both the content strings (as 'Left', never blank) and
+--   the direct child nodes (as 'Right').
+--   If you only want the child nodes, use 'children'.
+contents :: Config => Node -> [Either BS.ByteString Node]
+contents n@Node{source, slices=ParseDetails{inner}} =
+     f (Slice.start inner) (children n)
+    where
+        f :: Config => Int32 -> [Node] -> [Either BS.ByteString Node]
+        f i [] = string i (Slice.end inner) ++ []
+        f i (n@Node{slices=ParseDetails{outer}} : nn) = string i (Slice.start outer) ++ Right n
+                                                       : f (Slice.end outer) nn
+        string :: Config => Int32 -> Int32 -> [Either BS.ByteString Node]
+        string start end
+          | assert (start<=end || error (printf "start=%d, end=%d" start end)) False = undefined
+          | start == end = []
+          | otherwise = [Left $ Slice.render (Slice.fromOpenClose start end) source]
+
+-- | Get the direct child nodes of this node.
+children :: Node -> [Node]
+children Node{slices = ParseDetails{nodeContents}, ..} =
+  [ Node{..} | slices <- Slice.vector nodeContents nodesV ]
+
+-- | Get the direct children of this node which have a specific name.
+childrenBy :: Config => Node -> BS.ByteString -> [Node]
+childrenBy node str =
+  filter (\n -> name n == str) (children node)
+
+-- | Get the first attribute of this node which has a specific name, if there is one.
+attributeBy :: Config => Node -> BS.ByteString -> Maybe Attribute
+attributeBy node str = listToMaybe [ a | a@(Attribute name _) <- attributes node, name == str ]
+
+-- | Get the (line, col) coordinates of a node
+location :: Config => Node -> (Int, Int)
+location Node{source, slices=ParseDetails{outer}} =
+  BS.foldl' f (pair 1 1) $ BS.take (fromIntegral $ Slice.start outer) source
+    where
+        pair !a !b = (a,b)
+        f (!line, !col) c
+            | c == '\n' = pair (line+1) 1
+            | c == '\t' = pair line (col+8)
+            | otherwise = pair line (col+1)
+
+-- | Returns the XML bytestring reconstructed from the parsed AST.
+--   For the original XML, use `outer`
+rerender :: Node -> BS.ByteString
+rerender = inside
+    where
+        inside x = BS.concat $ map (either validStr node) $ contents x
+        node x = "<" <> BS.unwords (validName (name x) : map attr (attributes x)) <> ">" <>
+                 inside x <>
+                 "</" <> name x <> ">"
+        attr (Attribute a b) = validName a <> "=\"" <> validAttr b <> "\""
+
+        validName x | BS.all (\x -> isAlphaNum x || x `elem` ("-:_" :: String)) x = x
+                    | otherwise = error "Invalid name"
+        validAttr x | BS.notElem '\"' x = x
+                    | otherwise = error "Invalid attribute"
+        validStr x | BS.notElem '<' x || BS.isInfixOf "<!--" x = x
+                   | otherwise = error $ show ("Invalid string", x)
diff --git a/src/Text/Xml/Tiny/Internal.hs b/src/Text/Xml/Tiny/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Xml/Tiny/Internal.hs
@@ -0,0 +1,208 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DisambiguateRecordFields, NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
+
+-- | This module contains types and functions that are mostly
+--   intended for the test suite, and should be considered internal
+--   for all other purposes
+module Text.Xml.Tiny.Internal
+  (
+-- * XML Nodes
+    Node(..), Attribute(..)
+-- * ParseDetails
+  , ParseDetails(..), AttributeParseDetails(..)
+-- * Slices
+  , Slice(..)
+  , fromOpen, fromOpenClose, fromIndexPtr
+  , empty
+  , start, end
+  , take, drop, null
+  , vector, render, toList
+-- * Errors
+  , SrcLoc(..), Error(..), ErrorType(..)
+  ) where
+
+import Control.Exception
+import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Internal (ByteString(..))
+import Data.List (genericTake)
+import Data.Vector.Storable (Vector, (!))
+import qualified Data.Vector.Storable as V
+import Data.Word
+import GHC.Stack hiding (SrcLoc)
+import Foreign.ForeignPtr       (ForeignPtr)
+import Foreign
+import Prelude hiding (length, null, take, drop)
+
+import Text.Printf
+
+import Config
+
+
+-- A subset of a vector defined by an offset and length
+data Slice =
+  Slice { offset, length :: !Int32 }
+  deriving (Eq,Ord,Show)
+
+sInt :: Int
+sInt = sizeOf(0::Int32)
+
+instance Storable Slice where
+    sizeOf _ = sInt * 2
+    alignment _ = alignment (0 :: Int64)
+    peek p = Slice <$> peekByteOff p 0 <*> peekByteOff p sInt
+    poke p Slice{..} = pokeByteOff p 0 offset >> pokeByteOff p sInt length
+
+{-# INLINE empty #-}
+empty :: Slice
+empty = Slice 0 0
+
+fromOpen:: Config => Integral a => a -> Slice
+fromOpen o = Slice (fromIntegral o) 0
+
+{-# INLINE fromOpenClose #-}
+fromOpenClose :: Config => (Integral a1, Integral a) => a -> a1 -> Slice
+fromOpenClose (fromIntegral->open) (fromIntegral->close) = Slice open (close-open)
+
+{-# INLINE null #-}
+null :: Config => Slice -> Bool
+null (Slice _ l) = l == 0
+
+{-# INLINE take #-}
+take :: Config => Integral a => a -> Slice -> Slice
+take !(fromIntegral -> i) (Slice o l) = assert (l>=i) $ Slice o i
+
+{-# INLINE drop #-}
+drop :: Config => Integral t => t -> Slice -> Slice
+drop !(fromIntegral -> i) (Slice o l) = assert (l>=i || error(printf "drop %d (Slice %d %d)" i o l)) $ Slice (o+i) (l-i) 
+
+-- | Inclusive
+start :: Config => Slice -> Int32
+start = offset
+
+-- | Non inclusive
+end :: Config => Slice -> Int32
+end (Slice o l) = o + l
+
+-- | Returns a list of indexes
+toList :: Config => Slice -> [Int]
+toList (Slice o l) = genericTake l [ fromIntegral o ..]
+
+{-# INLINE fromIndexPtr #-}
+-- | Apply a slice to a foreign ptr of word characters and wrap as a bytestring
+fromIndexPtr :: Config => Slice -> ForeignPtr Word8 -> ByteString
+fromIndexPtr (Slice o l) fptr = PS fptr (fromIntegral o) (fromIntegral l)
+
+-- | Apply a slice to a bytestring
+render :: Config => Slice -> ByteString -> ByteString
+render(Slice o l) _ | trace (printf "Render slice %d %d" o l) False = undefined
+render(Slice o l) _ | assert (o >= 0 && l >= 0) False = undefined
+render(Slice o l) (PS fptr _ _) = PS fptr (fromIntegral o) (fromIntegral l)
+
+-- | Apply a slice to a vector
+vector :: Config => Storable a => Slice -> Vector a -> [a]
+vector s v = [ v ! i
+              | i <- toList s
+              , assert (i < V.length v) True ]
+
+-- * XML Nodes
+
+-- | A parsed XML node
+data Node =
+  Node{ attributesV :: !(Vector AttributeParseDetails) -- ^ All the attributes in the document
+      , nodesV      :: !(Vector ParseDetails)          -- ^ All the nodes in the document
+      , source      :: !ByteString                     -- ^ The document bytes
+      , slices      :: !ParseDetails                   -- ^ Details for this node
+      }
+
+-- | A parsed XML attribute
+data Attribute = Attribute { attributeName, attributeValue :: !ByteString } deriving (Eq, Show)
+
+data ParseDetails =
+    ParseDetails
+    { name :: {-# UNPACK #-} !Slice     -- ^ bytestring slice
+    , inner :: {-# UNPACK #-} !Slice    -- ^ bytestring slice
+    , outer :: {-# UNPACK #-} !Slice    -- ^ bytestring slice
+    , attributes :: {-# UNPACK #-} !Slice   -- ^ ParseDetailsAttribute slice
+    , nodeContents :: {-# UNPACK #-} !Slice -- ^ ParseDetails slice of children
+    }
+    -- | An incompletely defined set of parse details
+  | ProtoParseDetails { name, attributes :: !Slice, innerStart, outerStart :: !Int32 }
+  deriving (Show)
+
+-- | Assumes that a name can never be the empty slice
+instance Storable ParseDetails where
+  sizeOf    _ = sizeOf empty * 5
+  alignment _ = alignment(0::Int)
+  poke !q (ParseDetails a b c d e)  = let p = castPtr q in pokeElemOff p 0 a >> pokeElemOff p 1 b >> pokeElemOff p 2 c >> pokeElemOff p 3 d >> pokeElemOff p 4 e
+  poke !q (ProtoParseDetails (Slice no nl) (Slice ao al) i o) = do
+    let !p = castPtr q
+    pokeElemOff p 0 no
+    pokeElemOff p 1 (0::Int32)
+    pokeElemOff p 2 nl
+    pokeElemOff p 3 ao
+    pokeElemOff p 4 al
+    pokeElemOff p 5 i
+    pokeElemOff p 6 o
+  peek q = do
+    let !p = castPtr q
+    !header <- peekElemOff p 1
+    if header == (0::Int32)
+      then protoNode <$> peekElemOff p 0 <*> peekElemOff p 2 <*> peekElemOff p 3 <*> peekElemOff p 4 <*> peekElemOff p 5 <*> peekElemOff p 6
+      else let !p = castPtr q in ParseDetails <$> peekElemOff p 0 <*> peekElemOff p 1 <*> peekElemOff p 2 <*> peekElemOff p 3 <*> peekElemOff p 4
+     where
+       protoNode no nl ao al = ProtoParseDetails (Slice no nl) (Slice ao al)
+
+data AttributeParseDetails =
+  AttributeParseDetails
+  { nameA :: {-# UNPACK #-} !Slice,
+    value :: {-# UNPACK #-} !Slice
+  }
+  deriving (Eq, Show)
+
+instance Storable AttributeParseDetails where
+  sizeOf _ = sizeOf empty * 2
+  alignment _ = alignment (0 :: Int)
+  peek !q = do
+    let !p = castPtr q :: Ptr Slice
+    !a <- peekElemOff p 0
+    !b <- peekElemOff p 1
+    return (AttributeParseDetails a b)
+  poke !q (AttributeParseDetails a b)= do
+    let !p = castPtr q :: Ptr Slice
+    pokeElemOff p 0 a
+    pokeElemOff p 1 b
+
+-- * Error types
+
+newtype SrcLoc = SrcLoc Int deriving Show
+
+data Error = Error ErrorType CallStack
+data ErrorType =
+    UnterminatedComment SrcLoc
+  | UnterminatedTag String SrcLoc
+  | ClosingTagMismatch String SrcLoc
+  | JunkAtTheEnd Slice SrcLoc
+  | UnexpectedEndOfStream
+  | BadAttributeForm SrcLoc
+  | BadTagForm SrcLoc
+  | UnfinishedComment SrcLoc
+  | Garbage SrcLoc
+  | InvalidNullName SrcLoc
+   deriving Show
+
+#if __GLASGOW_HASKELL__ < 800
+prettyCallStack = show
+#endif
+
+instance Exception Error
+
+instance Show Error where
+  show (Error etype cs) = show etype ++ prettyCallStack cs
diff --git a/src/Text/Xml/Tiny/Internal/Checks.hs b/src/Text/Xml/Tiny/Internal/Checks.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Xml/Tiny/Internal/Checks.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE ViewPatterns, NamedFieldPuns, CPP #-}
+module Text.Xml.Tiny.Internal.Checks where
+
+import Text.Printf
+
+#ifdef ENABLE_CONSISTENCY_CHECKS
+doStackChecks = True
+doCursorChecks = True
+doParseTableChecks = True
+#else
+doStackChecks = False
+doCursorChecks = False
+doParseTableChecks = False
+#endif
+{-# INLINE doStackChecks #-}
+{-# INLINE doCursorChecks #-}
+{-# INLINE doParseTableChecks #-}
+
+-- checkCursor :: ParseMonad s ()
+checkBSaccess o l o0 l0 =
+      let valid n = let x = fromIntegral n in x >= o0 && x < o0+l0
+          check = (valid o && valid (o+l))
+              || error (printf "access to source out of bounds: o=%d, l=%d" o l)
+      in check `seq` ()
diff --git a/src/Text/Xml/Tiny/Internal/Monad.hs b/src/Text/Xml/Tiny/Internal/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Xml/Tiny/Internal/Monad.hs
@@ -0,0 +1,287 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fobject-code #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns, BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE MagicHash  #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE CPP #-}
+
+module Text.Xml.Tiny.Internal.Monad where
+import qualified Control.Exception as CE
+import Control.Monad
+import Control.Monad.Primitive
+import Control.Monad.ST
+import Control.Monad.ST.Unsafe
+import GHC.ST (ST(..))
+import Control.Monad.State.Class
+import Data.ByteString.Internal (ByteString(..), c2w, w2c, memchr, memcmp)
+import qualified Data.ByteString.Char8 as BS
+import Data.Int
+import Data.Word
+import Foreign.ForeignPtr
+import Foreign.ForeignPtr.Unsafe
+import Foreign.Storable hiding (peek)
+import qualified Foreign.Storable as Foreign
+import Foreign.Ptr
+import GHC.Int
+
+import Data.VectorBuilder.Storable (VectorBuilder)
+import qualified Data.VectorBuilder.Storable as VectorBuilder
+import Text.Xml.Tiny.Internal as Slice
+import Text.Xml.Tiny.Internal.Checks
+
+import Config
+import qualified GHC.Stack
+import Text.Printf
+
+type MonadParse m = MonadState ParseState m
+
+type ParseState = Slice
+
+-- | The mutable environment of the ParseMonad.
+data Env s =
+  Env { source          :: !ByteString  -- ^ The input bytestring containing the XML document
+      , ptr             :: {-# UNPACK #-} !(Ptr Word8) -- ^ A pointer to the raw bits of the above bytestring
+      , attributeBuffer :: {-# UNPACK #-} !(VectorBuilder s AttributeParseDetails) -- ^ All the attributes parsed so far
+      , nodeBuffer      :: {-# UNPACK #-} !(VectorBuilder s ParseDetails) -- ^ All the nodes parsed so far
+      }
+
+-- | A Reader Env, State Slice, ST monad,
+--   the cursor Slice is deconstructed to its component in the STS monad.
+newtype ParseMonad s a = PM {unPM :: Env s -> Slice -> ST s (a,Slice)}
+
+liftST :: Config => ST s a -> ParseMonad s a
+liftST action = PM $ \_ slice -> (,slice) <$> action
+
+unsafeLiftIO :: Config => IO a -> ParseMonad s a
+unsafeLiftIO action = liftST (unsafeIOToST action)
+
+runPM :: Config => ByteString -> (forall s. ParseMonad s a) -> a
+runPM bs@(PS fptr (fromIntegral -> o) (fromIntegral -> l)) pm = runST $ do
+  -- initial buffer sizes copied from hexml
+  attributes <- VectorBuilder.new 1000
+  nodes <- VectorBuilder.new 500
+  let ptr = unsafeForeignPtrToPtr fptr
+  (res,_) <- unPM pm (Env bs ptr attributes nodes) (Slice o l)
+  return res
+
+-- | Render a BS slice in the source bytestring.
+readStr :: Config => Slice -> ParseMonad s ByteString
+readStr str = do
+  Env{source = PS fptr _ _} <- getEnv
+  return $! fromIndexPtr str fptr
+
+{-# INLINE getBS #-}
+-- | Get the rest of the document from the current cursor
+getBS :: Config => ParseMonad s ByteString
+getBS = get >>= readStr
+
+unsafeIO :: Config => String -> IO a -> ParseMonad s a
+unsafeIO msg action = unsafeLiftIO $ do
+#ifdef TRACE_UNSAFE
+  res <- trace ("About to start unsafe IO: " ++ msg) $ action
+  trace ("Completed unsafe IO: " ++ msg) $ return res
+#else
+  action
+#endif
+
+{-# INLINE withCursor #-}
+withCursor k = do
+  checkCursor
+  Env{ptr=p} <- getEnv
+  Slice o l <- get
+  k p o l
+
+-- | Look ahead. Peek at the current cursor (CPS to avoid unnecesary allocations)
+peek :: Config => (Char -> a) -> ParseMonad s a
+peek = peekAt 0
+
+-- | Arbitrary look-ahead (CPS)
+peekAt :: Config => Int32 -> (Char -> a) -> ParseMonad s a
+peekAt i pred = withCursor $ \p o l ->
+  if (l < i) then throw UnexpectedEndOfStream else peekAtUnsafePO i pred p o
+
+{-# INLINE peekAtUnsafePO #-}
+peekAtUnsafePO i pred p o = (pred.w2c) <$> unsafeIO "BS" (peekByteOff p (fromIntegral $ i + o))
+
+-- | Look-ahead a pair of positions, optimizing a common case (CPS)
+bsIndex2 :: Config => Int32 -> Int32 -> (Char -> Char -> a) -> ParseMonad s a
+bsIndex2 i j pred = withCursor $ \p o l ->
+  if (l<i || l<j) then throw UnexpectedEndOfStream else do
+    checkCursor
+    byteI <- peekAtUnsafePO i id p o
+    byteJ <- peekAtUnsafePO j id p o
+    return $ pred byteI byteJ
+
+-- | isPrefix at the current cursor
+bsIsPrefix :: Config => ByteString -> ParseMonad s Bool
+bsIsPrefix (PS r o' l') = withCursor $ \p o _ -> do
+  resp <-
+        unsafeIO "memcmp" $ withForeignPtr r $ \p' ->
+          memcmp (p' `plusPtr` o') (p `plusPtr` fromIntegral o) (fromIntegral l')
+  let res = resp == 0
+  return res
+
+-- | elem index from the current cursor
+bsElemIndex :: Char -> ParseMonad s (Maybe Int)
+bsElemIndex c = withCursor $ \p o l -> do
+  let !p' = p `plusPtr` fromIntegral o
+  !q <- unsafeIO "memchr" $ memchr p' (c2w c) (fromIntegral l)
+  let !res = if q == nullPtr then Nothing else Just $! q `minusPtr` p'
+  return res
+{-# INLINE bsElemIndex #-}
+
+-- | drop while from the current cursor
+bsDropWhile :: (Char -> Bool) -> ParseMonad s ()
+bsDropWhile f = withCursor $ \p o l -> do
+  !n <- unsafeIO "BS" $ findIndexOrEnd (not.f.w2c) (p `plusPtr` fromIntegral o) l
+  put $ Slice (o+n) (l-n)
+{-# INLINE bsDropWhile #-}
+
+-- | Move the cursor ahead while the predicate is true, and return the dropped slice.
+{-# INLINE bsSpan #-}
+bsSpan :: (Char -> Bool) -> ParseMonad s Slice
+bsSpan f = withCursor $ \ p o l -> do
+  !n <- unsafeIO "BS" $ findIndexOrEnd (not.f.w2c) (p `plusPtr` fromIntegral o) l
+  put $ Slice (o+n) (l-n)
+  return $! Slice o n
+
+{-# INLINE findIndexOrEnd #-}
+findIndexOrEnd k p l = go p 0 where
+    go !ptr !n | n >= l    = return l
+               | otherwise = do !w <- Foreign.peek ptr
+                                if k w
+                                  then return n
+                                  else go (ptr `plusPtr` 1) (n+1)
+
+-- | Return the current cursor location
+{-# INLINE loc #-}
+loc :: ParseMonad s SrcLoc
+loc = get >>= \ (Slice o _) -> return $ SrcLoc $ fromIntegral o
+
+throw :: HasCallStack => ErrorType -> a
+#if __GLASGOW_HASKELL__ < 800
+throw e = CE.throw $ Error e ?callStack
+#else
+throw e = CE.throw $ Error e GHC.Stack.callStack
+#endif
+
+-- | Throw with the current cursor location
+throwLoc :: Config => (SrcLoc -> ErrorType) -> ParseMonad s a
+throwLoc e = loc >>= throw . e
+
+{-# INLINE getEnv #-}
+getEnv :: ParseMonad s (Env s)
+getEnv = PM $ \e s -> return (e,s)
+
+-- | Push a node into the temporary stack
+pushNode :: Config => ParseDetails -> ParseMonad s Int32
+pushNode node = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.push nodeBuffer node
+{-# INLINE pushNode #-}
+
+{-# INLINE popNodes #-}
+-- | Pop the topmost n elements from the node buffer stack
+popNodes :: Config => Int32 -> ParseMonad s ()
+popNodes n = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.pop nodeBuffer n
+
+peekNode :: Config => Int32 -> ParseMonad s ParseDetails
+peekNode n = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.peek nodeBuffer n
+{-# INLINE peekNode #-}
+
+-- | Insert a node into permanent storage
+insertNode :: Config => ParseDetails -> ParseMonad s ()
+insertNode node = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.insert nodeBuffer node
+{-# INLINE insertNode #-}
+
+insertAttribute :: AttributeParseDetails -> ParseMonad s ()
+insertAttribute att = do
+  Env{attributeBuffer} <- getEnv
+  VectorBuilder.insert attributeBuffer att
+{-# INLINE insertAttribute #-}
+
+getNodeBufferCount, getAttributeBufferCount, getNodeStackCount :: Config => ParseMonad s Int32
+getNodeBufferCount = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.getCount nodeBuffer
+{-# INLINE getNodeBufferCount #-}
+
+getAttributeBufferCount = do
+  Env{attributeBuffer} <- getEnv
+  VectorBuilder.getCount attributeBuffer
+{-# INLINE getAttributeBufferCount #-}
+
+getNodeStackCount = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.getStackCount nodeBuffer
+{-# INLINE getNodeStackCount #-}
+
+-- | Update a node in the stack buffer
+{-# INLINE updateNode #-}
+updateNode :: Int32 -> (ParseDetails -> ParseDetails) -> ParseMonad s ()
+updateNode i f = do
+  Env{nodeBuffer} <- getEnv
+  VectorBuilder.updateStackElt nodeBuffer i f
+
+instance Functor (ParseMonad s) where
+  fmap = liftM
+
+instance Applicative (ParseMonad s) where
+  pure x = PM (\_ s -> return (x,s))
+  (<*>) = ap
+
+instance Monad (ParseMonad s) where
+  {-# INLINE (>>=) #-}
+  PM m >>= k = PM (\e s -> m e s >>= \(a,s') -> unPM (k a) e s')
+
+instance MonadState ParseState (ParseMonad s) where
+  get = PM $ \_ s -> return (s,s)
+  put s = PM $ \_ _ -> return ((), s)
+
+instance PrimMonad (ParseMonad s) where
+  type PrimState(ParseMonad s) = s
+  {-# INLINE primitive #-}
+  primitive act = PM (\_ s -> (,s) <$> ST act )
+
+checkCursor
+  | doCursorChecks = do
+      Env{source = PS _ o0 l0} <- getEnv
+      Slice o l <- get
+      return $ checkBSaccess o l o0 l0
+  | otherwise = return ()
+
+checkConsistency (fromIntegral -> outerStart) (fromIntegral -> innerClose) origStr seenStr
+  | doStackChecks = do
+            nameBS_original <- readStr origStr
+            seenBS <- readStr seenStr
+            unless (seenBS == nameBS_original) $ do
+                xml <- readStr(Slice outerStart (min 100 $ innerClose + fromIntegral( Slice.length origStr) + 4 - outerStart))
+                total <- getNodeStackCount
+                let go n
+                     | n >= total = return []
+                     | otherwise = do
+                          node <- peekNode n
+                          nBS <- readStr (name node)
+                          (BS.unpack nBS :) <$> go (n+1)
+                stackNames <- go 0
+                error $ printf "Inconsistency detected in the node stack while parsing %s...\n Expected %s(%s), but obtained %s(%s) (and the stack contains %s)"
+                                (BS.unpack xml) (BS.unpack nameBS_original) (show origStr) (BS.unpack seenBS) (show seenStr)(show stackNames)
+  | otherwise =
+      return ()
+
+{-# INLINE checkConsistency #-}
+{-# INLINE checkCursor #-}
diff --git a/src/Text/Xml/Tiny/Internal/Parser.hs b/src/Text/Xml/Tiny/Internal/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Xml/Tiny/Internal/Parser.hs
@@ -0,0 +1,277 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | A hand rolled predictive recursive descent parser for a subset of XML.
+--   There is no lexer, the parser assumes Char8 tokens.
+--   The parser state is held in the Environment data structure of a ParseMonad
+module Text.Xml.Tiny.Internal.Parser (parse) where
+
+import Control.Exception (try, evaluate, assert)
+import Control.Monad
+import Control.Monad.State.Class
+import qualified Data.ByteString.Char8 as BS
+import Data.ByteString.Internal (ByteString(..))
+import Data.Char hiding (Space)
+import qualified Data.VectorBuilder.Storable as VectorBuilder
+import qualified Data.Vector.Unboxed as U
+import System.IO.Unsafe
+import Text.Printf
+
+import Text.Xml.Tiny.Internal.Monad
+import Text.Xml.Tiny.Internal as Slice
+import Config
+
+default (Int, Double)
+
+{-# INLINE skip #-}
+skip :: (Integral a, Config) => a -> ParseMonad s ()
+skip = modify . Slice.drop
+
+{-# INLINE pop #-}
+pop :: Config => (Char -> a) -> ParseMonad s a
+pop pred = peek pred <* skip 1
+
+{-# INLINE findAndPop #-}
+findAndPop :: Config => Char -> (SrcLoc -> ErrorType) -> (Slice -> ParseMonad s r) -> ParseMonad s r
+findAndPop !c mkE k = do
+  !x <- bsElemIndex c
+  case x of
+    Nothing ->
+      throwLoc mkE
+    Just !i -> do
+      cursor <- get
+      let !prefix = Slice.take i cursor
+      put(Slice.drop (i+1) cursor)
+      k prefix
+
+{-# INLINE trim #-}
+trim :: Config => ParseMonad s ()
+trim =
+  bsDropWhile isSpace
+    where
+      isSpace !c = spaceTable `indexU` ord c
+
+{-# INLINE expectLoc #-}
+expectLoc :: Config => (Char -> Bool) -> _ -> ParseMonad s ()
+expectLoc pred e = do
+  !b <- peek pred
+  unless b $ do
+    c <- pop id
+    throwLoc(e c)
+  skip 1
+
+{-# INLINE parseName #-}
+parseName :: Config => ParseMonad s Slice
+parseName = do
+  !first <- peek isName1
+  case first of
+    False -> return Slice.empty
+    True  -> do
+      slice@(Slice _ l) <- bsSpan isName
+      assert (l > 0 || error(show slice)) $ return slice
+ where
+    isName1 c = nameTable1 `indexU` ord c
+    isName  c = nameTable  `indexU` ord c
+
+-- | Assumes cursor is on a '='
+{-# INLINE parseAttrVal #-}
+parseAttrVal :: Config => Slice -> ParseMonad s ()
+parseAttrVal n = do
+  trim
+  expectLoc (== '=') (const BadAttributeForm)
+  trim
+  !c  <- pop id
+  unless (c == '\'' || c == '\"') (throwLoc BadAttributeForm)
+  findAndPop c BadAttributeForm (insertAttribute . AttributeParseDetails n)
+
+{-# INLINE parseAttr #-}
+parseAttr :: Config => ParseMonad s Bool
+parseAttr = do
+    trim
+    !n <- parseName
+    if Slice.null n
+      then return False
+      else do
+        parseAttrVal n
+        return True
+
+parseAttrs :: Config => ParseMonad s Slice
+parseAttrs = do
+  !initial <- getAttributeBufferCount
+  let goParseAttrs = do
+        !success <- parseAttr
+        when success goParseAttrs
+  goParseAttrs
+  !current <- getAttributeBufferCount
+  return (Slice (fromIntegral initial) (fromIntegral $ current-initial))
+{-# INLINE parseAttrs #-}
+
+{-# INLINE parseNode #-}
+parseNode :: Config => ParseMonad s ()
+parseNode = do
+    SrcLoc outerOpen <- loc
+    expectLoc (== '<') $ \c -> error( "parseNode: expected < got " ++ [c] )
+    !c <- peek (== '?')
+    when c (skip 1)
+    !name <- parseName
+    when (Slice.null name) $ throwLoc InvalidNullName
+    do
+        !attrs <- parseAttrs
+        (isTagEnd, isTagClose) <- bsIndex2 0 1 $ \c n -> ((c == '/' || c == '?') && n == '>', c == '>')
+        skip 1
+        if isTagEnd
+          -- this is a tag with no children
+          then do
+            skip 1
+            SrcLoc outerClose <- loc
+            let !outer = fromOpenClose outerOpen outerClose
+            let inner = Slice.empty
+            _ <- pushNode(ParseDetails name inner outer attrs Slice.empty)
+            return ()
+          else do
+            unless isTagClose $ do
+              nameBS <- readStr name
+              throwLoc (UnterminatedTag$ BS.unpack nameBS)
+            SrcLoc innerOpen <- loc
+            -- record a partial entry to insert at the right point in the stack
+            -- and to (hopefully) allow the GC to release all the node details already
+            me <- pushNode(ProtoParseDetails name attrs (fromIntegral innerOpen) (fromIntegral outerOpen))
+            !nn <- parseContents
+            SrcLoc innerClose <- loc
+            isTagEnd <- bsIndex2 0 1 $ \c n -> c == '<' && n == '/'
+            skip 2
+            !nameBS <- readStr name
+            unless isTagEnd $ throwLoc (UnterminatedTag $ BS.unpack nameBS)
+            !matchTag <- bsIsPrefix nameBS
+            unless matchTag $
+              throwLoc (ClosingTagMismatch $ BS.unpack nameBS)
+            skip $! Slice.length name
+            !bracket <- bsElemIndex '>'
+            case bracket of
+              Just i  -> skip $! (i+1)
+              Nothing -> throwLoc BadTagForm
+            SrcLoc outerClose <- loc
+            -- Update the stack entry with the full details now
+            updateNode me $ \n@ProtoParseDetails{name=name', innerStart = innerOpen', outerStart = outerOpen', attributes=attrs'} ->
+              assert (name==name') $
+              assert (innerOpen == fromIntegral innerOpen' || error (printf "Expected:%d, Obtained:%d, me: %d, node: %s" innerOpen innerOpen' me (show n))) $
+              assert (outerOpen == fromIntegral outerOpen' || error (printf "Expected:%d, Obtained:%d" outerOpen outerOpen')) $
+              ParseDetails name' (fromOpenClose innerOpen' innerClose) (fromOpenClose outerOpen' outerClose) attrs' nn
+
+commentEnd :: ParseMonad s ()
+{-# INLINE commentEnd #-}
+commentEnd  = do
+  !end <- bsElemIndex '>'
+  case end of
+    Nothing -> throwLoc UnfinishedComment
+    Just !end -> do
+      skip $! (end+1)
+      isEnd <- bsIndex2 (-2) (-3) $ \p p' -> p == '-' && p' == '-'
+      unless isEnd commentEnd
+
+{-# INLINE dropComments #-}
+dropComments :: ParseMonad s Bool
+dropComments = do
+  !x <- bsIsPrefix "<!--"
+  when x $ do
+    skip 4
+    commentEnd
+  return x
+
+-- | Parses a sequence of zero or more nodes.
+parseContents :: forall s. Config => ParseMonad s Slice
+parseContents = do
+  -- Record how many elements are there in the node stack before parsing the contents
+  !before <- getNodeStackCount
+
+  -- the recursive worker
+  let goParseContents :: Config => ParseMonad s ()
+      goParseContents = do
+        -- we can skip all characters until we find a start tag
+        -- this is key to good performance
+        !start <- bsElemIndex '<'
+        case start of
+          Just i -> do
+            skip i
+            -- if look ahead reveals the "</" sequence then this is an end tag and we're done
+            !end <- peekAt 1 (== '/')
+            unless end $ do
+                -- is this a real tag or a user comment ?
+                !wasComment <- dropComments
+                if wasComment
+                  then
+                    -- after wiping out comments, start over
+                    goParseContents
+                  else do
+                    -- looks like we've found a node, parse it and start over
+                    _ <- parseNode
+                    goParseContents
+          -- no tag
+          _ ->
+            return ()
+  -- loop until we run out of tag openers
+  () <- goParseContents
+  -- and find out how much the stack has grown
+  !after <- getNodeStackCount
+  !front <- getNodeBufferCount
+  -- The new unpopped items in the stack are the ones parsed by us
+  -- Pop them out an return a slice identifying them.
+  let diff = after - before
+  popNodes diff
+  return $! Slice front diff
+
+type ParseTable = U.Vector Bool
+
+-- TODO compute at compile time?
+spaceTable,nameTable,nameTable1 :: ParseTable
+spaceTable = U.generate 256 (isSpace . chr)
+
+nameTable = U.generate 256 $ \i ->
+   case chr i of
+      ':' -> True
+      '_' -> True
+      c | isLetter c -> True
+      '-' -> True
+      c | isDigit c -> True
+      _   -> False
+
+nameTable1 = U.generate 256 $ \i ->
+   case chr i of
+      ':' -> True
+      '_' -> True
+      c | isLetter c -> True
+      _   -> False
+
+#ifdef ENABLE_VECTOR_CHECKS
+indexU = (U.!)
+#else
+indexU = U.unsafeIndex
+#endif
+
+parse :: Config => ByteString -> Either Error _
+parse bs = unsafePerformIO $ do
+  res <- try $ evaluate $ runPM bs $ do
+    it <- parseContents
+    Env{attributeBuffer, nodeBuffer} <- getEnv
+    attributesV <- VectorBuilder.finalize attributeBuffer
+    nodesV <- VectorBuilder.finalize nodeBuffer
+    return (it, attributesV, nodesV)
+  let len = fromIntegral $ BS.length bs
+  return $! case res of
+    Right (!it, attributesV, nodesV) ->
+      let rootNode = ParseDetails Slice.empty (Slice 0 len) (Slice 0 len) Slice.empty it
+      in Right (attributesV, nodesV, rootNode )
+    Left e ->
+      Left e
diff --git a/tinyXml.cabal b/tinyXml.cabal
new file mode 100644
--- /dev/null
+++ b/tinyXml.cabal
@@ -0,0 +1,82 @@
+name:                tinyXml 
+
+-- The package version.  See the Haskell package versioning policy (PVP) 
+-- for standards guiding when and how versions should be incremented.
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.0
+
+synopsis:            A fast DOM parser for a subset of XML
+
+description:         Fast DOM parser for XML with no support for entities, CDATA sections nor namespaces.
+
+license:             BSD3
+
+license-file:        LICENSE
+
+author:              Pepe Iborra
+
+maintainer:          pepeiborra@gmail.com
+
+category:            XML
+
+build-type:          Simple
+
+extra-source-files:  ChangeLog.md, xml/benchmark.xml.bz2, xml/mail.xml.bz2
+extra-tmp-files:     xml/benchmark.xml, xml/mail.xml, xml/benchmark.xml.reprint, xml/mail.xml.reprint
+
+cabal-version:       >=1.22
+
+tested-with:         GHC == 7.10.3, GHC == 8.0.1
+
+source-repository head
+  type: git
+  location: https://github.com/pepeiborra/tinyXml
+
+Flag Debug
+    Description:     enables call stacks and other debug options
+    Default: False
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Text.Xml.Tiny,
+                       Text.Xml.Tiny.Internal
+  other-modules:       Config,
+                       Data.VectorBuilder.Storable,
+                       Text.Xml.Tiny.Internal.Parser,
+                       Text.Xml.Tiny.Internal.Checks,
+                       Text.Xml.Tiny.Internal.Monad
+
+  if impl(ghc < 8)
+            default-extensions: FlexibleContexts
+  other-extensions:    OverloadedStrings, BangPatterns, DisambiguateRecordFields, FlexibleContexts, TemplateHaskell, ConstraintKinds, NoMonomorphismRestriction, LambdaCase, OverloadedLists, PartialTypeSignatures
+  build-depends:       base >=4.8 && <5, bytestring >=0.10 && <0.11, mtl >=2.2 && <2.3, containers >=0.5 && <0.6, vector >= 0.11, primitive
+  default-language:    Haskell2010
+  if impl(ghc >= 8)
+    default-extensions:  StrictData
+  ghc-options:         -funfolding-use-threshold=10000
+  ghc-options:         -fno-warn-partial-type-signatures
+  if flag(Debug)
+     cpp-options:         -DDEBUG -DSTACKTRACES
+
+test-suite test
+        type: exitcode-stdio-1.0
+        main-is: Test.hs
+        -- we want to rebuild with asserts on
+        hs-source-dirs:      .,src
+        default-language:    Haskell2010
+        build-depends: base, bytestring, tinyXml, mtl, containers, vector >= 0.11, hexml, filepath, primitive, process
+        default-language:    Haskell2010
+        ghc-options:         -fno-warn-partial-type-signatures -fno-ignore-asserts -O0
+        cpp-options:         -DENABLE_CONSISTENCY_CHECKS -DENABLE_VECTOR_CHECKS -DDEBUG -DSTACKTRACES
+        if impl(ghc < 8)
+            default-extensions: FlexibleContexts
+
+Executable validate 
+        main-is: Validate.hs
+        build-depends:  base, bytestring, tinyXml, mtl, optparse-generic, directory, filepath
+        ghc-options: -rtsopts
+        default-language:    Haskell2010
+        ghc-options:         -fno-warn-partial-type-signatures -rtsopts
diff --git a/xml/benchmark.xml.bz2 b/xml/benchmark.xml.bz2
new file mode 100644
# file too large to diff: xml/benchmark.xml.bz2
diff --git a/xml/mail.xml.bz2 b/xml/mail.xml.bz2
new file mode 100644
Binary files /dev/null and b/xml/mail.xml.bz2 differ