module HaskellWorks.Data.Xml.Internal.Tables
  ( interestingWord8s
  , isInterestingWord8
  ) where

import Data.Word
import Data.Word8
import HaskellWorks.Data.AtIndex ((!!!))
import Prelude                   as P

import qualified Data.Vector.Storable as DVS

interestingWord8s :: DVS.Vector Word8
interestingWord8s :: Vector Word8
interestingWord8s = Int -> (Vector Word8 -> Word8) -> Vector Word8
forall a. Storable a => Int -> (Vector a -> a) -> Vector a
DVS.constructN Int
256 Vector Word8 -> Word8
go
  where go :: DVS.Vector Word8 -> Word8
        go :: Vector Word8 -> Word8
go Vector Word8
v = if     Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_bracketleft
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_braceleft
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_parenleft
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_bracketleft
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_less
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_a
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_v
                  Bool -> Bool -> Bool
||  Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_t
              then Word8
1
              else Word8
0
          where w :: Word8
                w :: Word8
w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8 -> Int
forall a. Storable a => Vector a -> Int
DVS.length Vector Word8
v)
{-# NOINLINE interestingWord8s #-}

isInterestingWord8 :: Word8 -> Word8
isInterestingWord8 :: Word8 -> Word8
isInterestingWord8 Word8
b = Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Word8
interestingWord8s Vector Word8 -> Position -> Elem (Vector Word8)
forall v. AtIndex v => v -> Position -> Elem v
!!! Word8 -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b)
{-# INLINABLE isInterestingWord8 #-}