nativeGen/aarch64: Fix handling of subword values

Here we rework the handling of sub-word operations in the AArch64
backend, fixing a number of bugs and inconsistencies. In short,
we now impose the invariant that all subword values are represented in
registers in zero-extended form. Signed arithmetic operations are then
responsible for sign-extending as necessary.

Possible future work:

 * Use `CMP`s extended register form to avoid burning an instruction
   in sign-extending the second operand.

 * Track sign-extension state of registers to elide redundant sign
   extensions in blocks with frequent sub-word signed arithmetic.

2 files changed, 39 insertions, 3 deletions

diff --git a/compiler/GHC/Cmm/Opt.hs b/compiler/GHC/Cmm/Opt.hs
index 131267e352..48581d8e64 100644
--- a/compiler/GHC/Cmm/Opt.hs
+++ b/compiler/GHC/Cmm/Opt.hs
@@ -149,7 +149,7 @@ cmmMachOpFoldM platform mop [CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 
         MO_Shl   r -> Just $! CmmLit (CmmInt (x   `shiftL` fromIntegral y) r)
         MO_U_Shr r -> Just $! CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
-        MO_S_Shr r -> Just $! CmmLit (CmmInt (x   `shiftR` fromIntegral y) r)
+        MO_S_Shr r -> Just $! CmmLit (CmmInt (x_s `shiftR` fromIntegral y) r)
 
         _          -> Nothing
 
diff --git a/compiler/GHC/Cmm/Type.hs b/compiler/GHC/Cmm/Type.hs
index 1227b37ced..b62aa01a90 100644
--- a/compiler/GHC/Cmm/Type.hs
+++ b/compiler/GHC/Cmm/Type.hs
@@ -186,16 +186,20 @@ instance Outputable Width where
    ppr rep = text (show rep)
 
 -------- Common Widths  ------------
+
+-- | The width of the current platform's word size.
 wordWidth :: Platform -> Width
 wordWidth platform = case platformWordSize platform of
  PW4 -> W32
  PW8 -> W64
 
+-- | The width of the current platform's half-word size.
 halfWordWidth :: Platform -> Width
 halfWordWidth platform = case platformWordSize platform of
  PW4 -> W16
  PW8 -> W32
 
+-- | A bit-mask for the lower half-word of current platform.
 halfWordMask :: Platform -> Integer
 halfWordMask platform = case platformWordSize platform of
  PW4 -> 0xFFFF
@@ -208,6 +212,7 @@ cIntWidth platform = case pc_CINT_SIZE (platformConstants platform) of
                    8 -> W64
                    s -> panic ("cIntWidth: Unknown cINT_SIZE: " ++ show s)
 
+-- | A width in bits.
 widthInBits :: Width -> Int
 widthInBits W8   = 8
 widthInBits W16  = 16
@@ -217,7 +222,9 @@ widthInBits W128 = 128
 widthInBits W256 = 256
 widthInBits W512 = 512
 
-
+-- | A width in bytes.
+--
+-- > widthFromBytes (widthInBytes w) === w
 widthInBytes :: Width -> Int
 widthInBytes W8   = 1
 widthInBytes W16  = 2
@@ -228,6 +235,7 @@ widthInBytes W256 = 32
 widthInBytes W512 = 64
 
 
+-- | *Partial* A width from the number of bytes.
 widthFromBytes :: Int -> Width
 widthFromBytes 1  = W8
 widthFromBytes 2  = W16
@@ -239,7 +247,7 @@ widthFromBytes 64 = W512
 
 widthFromBytes n  = pprPanic "no width for given number of bytes" (ppr n)
 
--- log_2 of the width in bytes, useful for generating shifts.
+-- | log_2 of the width in bytes, useful for generating shifts.
 widthInLog :: Width -> Int
 widthInLog W8   = 0
 widthInLog W16  = 1
@@ -252,6 +260,20 @@ widthInLog W512 = 6
 
 -- widening / narrowing
 
+-- | Narrow a signed or unsigned value to the given width. The result will
+-- reside in @[0, +2^width)@.
+--
+-- >>> narrowU W8 256    == 256
+-- >>> narrowU W8 255    == 255
+-- >>> narrowU W8 128    == 128
+-- >>> narrowU W8 127    == 127
+-- >>> narrowU W8 0      == 0
+-- >>> narrowU W8 (-127) == 129
+-- >>> narrowU W8 (-128) == 128
+-- >>> narrowU W8 (-129) == 127
+-- >>> narrowU W8 (-255) == 1
+-- >>> narrowU W8 (-256) == 0
+--
 narrowU :: Width -> Integer -> Integer
 narrowU W8  x = fromIntegral (fromIntegral x :: Word8)
 narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
@@ -259,6 +281,20 @@ narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
 narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
 narrowU _ _ = panic "narrowTo"
 
+-- | Narrow a signed value to the given width. The result will reside
+-- in @[-2^(width-1), +2^(width-1))@.
+--
+-- >>> narrowS W8 256    == 0
+-- >>> narrowS W8 255    == -1
+-- >>> narrowS W8 128    == -128
+-- >>> narrowS W8 127    == 127
+-- >>> narrowS W8 0      == 0
+-- >>> narrowS W8 (-127) == -127
+-- >>> narrowS W8 (-128) == -128
+-- >>> narrowS W8 (-129) == 127
+-- >>> narrowS W8 (-255) == 1
+-- >>> narrowS W8 (-256) == 0
+--
 narrowS :: Width -> Integer -> Integer
 narrowS W8  x = fromIntegral (fromIntegral x :: Int8)
 narrowS W16 x = fromIntegral (fromIntegral x :: Int16)