BitVector.hs

module BitVector (BitVector, unsigned, signed, width, value, toHexStr) where
import Data.Bits
import Data.Monoid
import Text.Printf

data BitVector = BV Int Integer

width :: BitVector -> Int
width (BV w _) = w

value :: Integral a => BitVector -> a
value (BV _ v) = fromIntegral v

instance Monoid BitVector where
    mempty = BV 0 0
    (BV wa va) `mappend` (BV wb vb) = BV (wa+wb) (va `shiftL` wb .|. vb)

unsigned :: (Integral a, Show a) => Int -> a -> BitVector
unsigned w v | w <= 0 = error $ "bit width must be greater than or equal to 1."
             | v <  0 = error $ "negative value is given for unsigned."
             | (1::Integer) `shiftL` w > fromIntegral v = BV w (mask w v)
             | otherwise =
                 error $ show v ++ " is out of range of bit width " ++ show w

signed :: (Integral a, Show a) => Int -> a -> BitVector
signed w v | w <= 0 = error $ "bit width must be greater than or equal to 1."
           | v < 0 &&
             (1::Integer) `shiftL` (w-1) >= fromIntegral (-v) = BV w (mask w v)
           | (1::Integer) `shiftL` (w-1) >  fromIntegral   v  = BV w (mask w v)
           | otherwise =
               error $ show v ++ " is out of range of bit width " ++ show w

mask :: Integral a => Int -> a -> Integer
mask w v = ((1 `shiftL` w) - 1) .&. fromIntegral v

toHexStr :: BitVector -> String
toHexStr (BV width value) = printf format $ value
    where
      format = "%0" ++ show (width `div` 4) ++ "x"

PackToBV.hs

module Main where
import BitVector (BitVector)
import qualified BitVector as BV
import Control.Applicative ((<$>), (<*>), (<*))
import Text.Parsec (many1, option, sepBy, (<|>),
                    char, string, digit, spaces,
                    parserFail)
import Text.Parsec.String (Parser, parseFromFile)
import System.Environment (getArgs)
import Data.Monoid

data Format = Signed Int
            | Unsigned Int

unsigned :: (Integral a, Read a) => Parser a
unsigned = read <$> many1 digit

signed :: (Integral a, Read a) => Parser a
signed = (*) <$> option 1 sign <*> unsigned
    where
      sign = plus <|> minus
      plus = char '+' >> return 1
      minus = char '-' >> return (-1)

format :: Parser Format
format = signedF <|> unsignedF
    where signedF = char 's' >> Signed <$> unsigned
          unsignedF = char 'u' >> Unsigned <$> unsigned

values :: Parser [Integer]
values = sepBy signed (char ',')

forms :: Parser [Format]
forms = sepBy format (char ',')

entry :: Parser [BitVector]
entry = do
  vs <- values
  string "::"
  fs <- forms
  if length vs == length fs
  then return $ zipWith cons fs vs
  else parserFail "The number of the values and the formats shall be equal"
      where
        cons (Signed w) = BV.signed w
        cons (Unsigned w) = BV.unsigned w

readBVFromFile :: FilePath -> IO [[BitVector]]
readBVFromFile path =
    either (error . show) id <$> parseFromFile (many1 $ entry <* spaces) path

main :: IO ()
main = do
  [readFilePath] <- getArgs
  readBVFromFile readFilePath >>=
       (mapM_ putStrLn) . (map (BV.toHexStr . mconcat))

testData

256,-256::u16,s16
1,1,1::u3,u3,u3