{-# 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 String u Identity Char
whitespace = (Char -> Bool) -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isWhiteSpace ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"white space"
whitespaces :: ParsecT String u Identity ()
whitespaces = ParsecT String u Identity Char -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String u Identity Char
forall u. ParsecT String u Identity Char
whitespace ParsecT String u Identity ()
-> String -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"white spaces"


indirection :: ParsecT String u Identity (Key, IntSet)
indirection = do
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  Key
a <- CharParser u Key
forall i st. Integral i => CharParser st i
hexnum
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  [Key]
inds <- ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity [Key]
-> ParsecT String 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 String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (ParsecT String u Identity [Key]
 -> ParsecT String u Identity [Key])
-> ParsecT String u Identity [Key]
-> ParsecT String 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 String u Identity Char
-> ParsecT String 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 String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',')
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  (Key, IntSet) -> ParsecT String u Identity (Key, IntSet)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key, IntSet) -> ParsecT String u Identity (Key, IntSet))
-> (Key, IntSet) -> ParsecT String u Identity (Key, IntSet)
forall a b. (a -> b) -> a -> b
$ (Key
a,[Key] -> IntSet
IS.fromList [Key]
inds)
 

indirections :: ParsecT String u Identity (IntMap IntSet)
indirections = do
  [(Key, IntSet)]
inds <- ParsecT String u Identity (Key, IntSet)
-> ParsecT String u Identity [(Key, IntSet)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity (Key, IntSet)
forall u. ParsecT String u Identity (Key, IntSet)
indirection
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  IntMap IntSet -> ParsecT String u Identity (IntMap IntSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap IntSet -> ParsecT String u Identity (IntMap IntSet))
-> IntMap IntSet -> ParsecT String 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 :: String -> IO (Either ParseError (IntMap IntSet))
parse_indirections String
f = Parser (IntMap IntSet)
-> String -> IO (Either ParseError (IntMap IntSet))
forall a. Parser a -> String -> IO (Either ParseError a)
parseFromFile Parser (IntMap IntSet)
forall u. ParsecT String u Identity (IntMap IntSet)
indirections String
f