{-# OPTIONS_HADDOCK hide #-}


-- Parser that can be used to read .indirections file.
--
-- Example input line:
--   100000ed4 [100000ed6,100000f7c,100000f8c,1000010e7]

module Parser.ParserIndirections where

import Text.Parsec.Token
import Text.Parsec.Char (hexDigit)
import Text.Parsec.Combinator
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Number
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Word (Word8)
import Numeric (readHex)
import Data.List.Split (chunksOf)

isWhiteSpace :: Char -> Bool
isWhiteSpace Char
'\t' = Bool
True
isWhiteSpace Char
'\f' = Bool
True
isWhiteSpace Char
'\v' = Bool
True
isWhiteSpace Char
' ' = Bool
True
isWhiteSpace Char
_ = Bool
False 

whitespace :: ParsecT [Char] u Identity Char
whitespace = (Char -> Bool) -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isWhiteSpace ParsecT [Char] u Identity Char
-> [Char] -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"white space"
whitespaces :: ParsecT [Char] u Identity ()
whitespaces = ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall {u}. ParsecT [Char] u Identity Char
whitespace ParsecT [Char] u Identity ()
-> [Char] -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"white spaces"


indirection :: ParsecT [Char] u Identity (Key, IntSet)
indirection = do
  ParsecT [Char] u Identity ()
forall {u}. ParsecT [Char] u Identity ()
whitespaces
  Key
a <- CharParser u Key
forall i st. Integral i => CharParser st i
hexnum
  ParsecT [Char] u Identity ()
forall {u}. ParsecT [Char] u Identity ()
whitespaces
  [Key]
inds <- ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Key]
-> ParsecT [Char] u Identity [Key]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (ParsecT [Char] u Identity [Key]
 -> ParsecT [Char] u Identity [Key])
-> ParsecT [Char] u Identity [Key]
-> ParsecT [Char] u Identity [Key]
forall a b. (a -> b) -> a -> b
$ CharParser u Key
forall i st. Integral i => CharParser st i
hexnum CharParser u Key
-> ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity [Key]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` (Char -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  ParsecT [Char] u Identity ()
forall {u}. ParsecT [Char] u Identity ()
whitespaces
  ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  (Key, IntSet) -> ParsecT [Char] u Identity (Key, IntSet)
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key, IntSet) -> ParsecT [Char] u Identity (Key, IntSet))
-> (Key, IntSet) -> ParsecT [Char] u Identity (Key, IntSet)
forall a b. (a -> b) -> a -> b
$ (Key
a,[Key] -> IntSet
IS.fromList [Key]
inds)
 

indirections :: ParsecT [Char] u Identity (IntMap IntSet)
indirections = do
  [(Key, IntSet)]
inds <- ParsecT [Char] u Identity (Key, IntSet)
-> ParsecT [Char] u Identity [(Key, IntSet)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT [Char] u Identity (Key, IntSet)
forall {u}. ParsecT [Char] u Identity (Key, IntSet)
indirection
  ParsecT [Char] u Identity ()
forall {u}. ParsecT [Char] u Identity ()
whitespaces
  ParsecT [Char] u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  IntMap IntSet -> ParsecT [Char] u Identity (IntMap IntSet)
forall a. a -> ParsecT [Char] u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap IntSet -> ParsecT [Char] u Identity (IntMap IntSet))
-> IntMap IntSet -> ParsecT [Char] u Identity (IntMap IntSet)
forall a b. (a -> b) -> a -> b
$ [(Key, IntSet)] -> IntMap IntSet
forall a. [(Key, a)] -> IntMap a
IM.fromList ([(Key, IntSet)] -> IntMap IntSet)
-> [(Key, IntSet)] -> IntMap IntSet
forall a b. (a -> b) -> a -> b
$ [(Key, IntSet)]
inds

-- The parse function.
-- Takes as input a filename f and produces a list of instructions
-- to lists of instructions.
parse_indirections :: String -> IO (Either ParseError (IM.IntMap IS.IntSet))
parse_indirections :: [Char] -> IO (Either ParseError (IntMap IntSet))
parse_indirections [Char]
f = Parser (IntMap IntSet)
-> [Char] -> IO (Either ParseError (IntMap IntSet))
forall a. Parser a -> [Char] -> IO (Either ParseError a)
parseFromFile Parser (IntMap IntSet)
forall {u}. ParsecT [Char] u Identity (IntMap IntSet)
indirections [Char]
f