From b1616a2f1c303bb9b0489f226cce6b12aa809d0b Mon Sep 17 00:00:00 2001
From: Valentin Robert <val@galois.com>
Date: Wed, 6 Oct 2021 11:50:59 -0700
Subject: [PATCH] remove `Aligned` from `SubWord`

The `Aligned` constructor to `SubWord` is morally equivalent to `SubWord 0 0`.
While it is nice as a visual marker in code, it makes consuming `SubWord`s
often more verbose/redundant than it needs be.

This proposes removing it altogether, while preserving some readability with
the `aligned` value.  We could also add an `Aligned` pattern for `SubWord 0 _`,
but at the moment, we never actually need to pattern-match on `Aligned`.

It also makes it so `splitWord` and `getBitStringPartial` can take a `SubWord`
as input, rather than the length and word separately, which looked a bit out of
place.
---
 src/Data/LLVM/BitCode/GetBits.hs | 50 +++++++++++++++-----------------
 1 file changed, 23 insertions(+), 27 deletions(-)

diff --git a/src/Data/LLVM/BitCode/GetBits.hs b/src/Data/LLVM/BitCode/GetBits.hs
index 2914db63..77a6b8f1 100644
--- a/src/Data/LLVM/BitCode/GetBits.hs
+++ b/src/Data/LLVM/BitCode/GetBits.hs
@@ -13,12 +13,11 @@ module Data.LLVM.BitCode.GetBits (
 
 import Data.LLVM.BitCode.BitString
 
-import Control.Applicative (Applicative(..),Alternative(..),(<$>))
+import Control.Applicative (Alternative(..))
 import Control.Arrow (first)
 import Control.Monad (MonadPlus(..),when,replicateM_)
 import Data.Bits (shiftR)
 import Data.ByteString (ByteString)
-import Data.Monoid (mempty,mappend)
 import Data.Word (Word32)
 import qualified Data.Serialize as C
 
@@ -34,7 +33,7 @@ newtype GetBits a = GetBits { unGetBits :: SubWord -> C.Get (a,SubWord) }
 -- | Run a @GetBits@ action, returning its value, and the number of bits offset
 -- into the next byte of the stream.
 runGetBits :: GetBits a -> C.Get a
-runGetBits m = fst `fmap` unGetBits m Aligned
+runGetBits m = fst `fmap` unGetBits m aligned
 
 instance Functor GetBits where
   {-# INLINE fmap #-}
@@ -90,33 +89,34 @@ instance MonadPlus GetBits where
 -- files get padded to a 32-bit boundary.
 data SubWord
   = SubWord !Int !Word32
-  | Aligned
     deriving (Show)
 
-splitWord :: Int -> Int -> Word32 -> (BitString,Either Int SubWord)
-splitWord n l w = case compare n l of
-  LT -> (toBitString n (fromIntegral w), Right (SubWord (l - n) (w `shiftR` n)))
-  EQ -> (toBitString n (fromIntegral w), Right Aligned)
-  GT -> (toBitString l (fromIntegral w), Left (n - l))
+aligned :: SubWord
+aligned = SubWord 0 0
+
+splitWord :: Int -> SubWord -> (BitString, Either Int SubWord)
+splitWord n (SubWord l w)
+  | n <= l    = (toBitString n (fromIntegral w), Right (SubWord (l - n) (w `shiftR` n)))
+  | otherwise = (toBitString l (fromIntegral w), Left (n - l))
 
 -- | @getBitString n@ grabs a @BitString@ of length @n@ from the next incoming
 -- word, yielding the remainder partial word.  On @n@ = @0@, it does not
 -- actually consume the next word.  Should not be called to read more than one
 -- 32-bit word at a time (will fail on @n@ > 32).
 getBitString :: Int -> C.Get (BitString, SubWord)
-getBitString 0 = return (mempty, Aligned)
+getBitString 0 = return (mempty, aligned)
 getBitString n | n > 32 =
   fail $ "getBitString: refusing to read " ++ show n ++ " (> 32) bits."
-getBitString n = getBitStringPartial n 32 =<< C.getWord32le
-
--- | @getBitStringPartial n l w@ returns a @BitString@ of length @n@ from either
--- the current subword @w@ (with @l@ bits available), potentially also reading
--- the next incoming word if @n@ > @l@.  Should not be called to read more than
--- one 32-bit word at a time (will fail on @n@ > 32).
-getBitStringPartial :: Int -> Int -> Word32 -> C.Get (BitString, SubWord)
-getBitStringPartial n _ _ | n > 32 =
+getBitString n = getBitStringPartial n . SubWord 32 =<< C.getWord32le
+
+-- | @getBitStringPartial n sw@ returns a @BitString@ of length @n@ from either
+-- the current subword @sw@ (with some @l@ bits available), potentially also
+-- reading the next incoming word if @n@ > @l@.  Should not be called to read
+-- more than one 32-bit word at a time (will fail on @n@ > 32).
+getBitStringPartial :: Int -> SubWord -> C.Get (BitString, SubWord)
+getBitStringPartial n _ | n > 32 =
   fail $ "getBitStringPartial: refusing to read " ++ show n ++ " (> 32) bits."
-getBitStringPartial n l w = case splitWord n l w of
+getBitStringPartial n sw = case splitWord n sw of
   (bs, Right off) -> return (bs, off)
   (bs, Left n') -> do
     (rest, off) <- getBitString n'
@@ -129,11 +129,11 @@ skipZeroByte = do
   when (x /= 0) $ fail "alignment padding was not zeros"
 
 -- | Get a @ByteString@ of @n@ bytes, and then align to 32 bits.
-getByteString :: Int -> C.Get (ByteString,SubWord)
+getByteString :: Int -> C.Get (ByteString, SubWord)
 getByteString n = do
   bs <- C.getByteString n
   replicateM_ ((- n) `mod` 4) skipZeroByte
-  return (bs, Aligned)
+  return (bs, aligned)
 
 
 -- Basic Interface -------------------------------------------------------------
@@ -141,20 +141,16 @@ getByteString n = do
 -- | Read zeros up to an alignment of 32-bits.
 align32bits :: GetBits ()
 align32bits  = GetBits $ \ off -> case off of
-  Aligned     -> return ((),Aligned)
-  SubWord _ 0 -> return ((),Aligned)
+  SubWord _ 0 -> return ((), aligned)
   SubWord _ _ -> fail "alignment padding was not zeros"
 
 -- | Read out n bits as a @BitString@.
 fixed :: Int -> GetBits BitString
-fixed n = GetBits $ \ off -> case off of
-  Aligned     -> getBitString n
-  SubWord l w -> getBitStringPartial n l w
+fixed n = GetBits $ getBitStringPartial n
 
 -- | Read out n bytes as a @ByteString@, aligning to a 32-bit boundary before and after.
 bytestring :: Int -> GetBits ByteString
 bytestring n = GetBits $ \ off -> case off of
-  Aligned     -> getByteString n
   SubWord _ 0 -> getByteString n
   SubWord _ _ -> fail "alignment padding was not zeros"