compiler: fix subword literal narrowing logic in the wasm NCG

This patch fixes the W8/W16 literal narrowing logic in the wasm NCG,
which used to lower it to something like i32.const -1, without
properly zeroing-out the unused higher bits. Fixes #22608.

(cherry picked from commit 7e11c6dc25cb9dd14ae33ee9715ddbc8ebf9836e)

4 files changed, 15 insertions, 20 deletions

diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
index 6f342818a4..d7acc0e459 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs
@@ -118,10 +118,10 @@ asmTellDefSym sym = do
 
 asmTellDataSectionContent :: WasmTypeTag w -> DataSectionContent -> WasmAsmM ()
 asmTellDataSectionContent ty_word c = asmTellTabLine $ case c of
-  DataI8 i -> ".int8 " <> integerDec i
-  DataI16 i -> ".int16 " <> integerDec i
-  DataI32 i -> ".int32 " <> integerDec i
-  DataI64 i -> ".int64 " <> integerDec i
+  DataI8 i -> ".int8 0x" <> word8Hex i
+  DataI16 i -> ".int16 0x" <> word16Hex i
+  DataI32 i -> ".int32 0x" <> word32Hex i
+  DataI64 i -> ".int64 0x" <> word64Hex i
   DataF32 f -> ".int32 0x" <> word32Hex (castFloatToWord32 f)
   DataF64 d -> ".int64 0x" <> word64Hex (castDoubleToWord64 d)
   DataSym sym o ->
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
index e1ca600cba..2a2fafda4a 100644
--- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
@@ -134,10 +134,10 @@ alignmentFromCmmSection t lbl
 -- | Lower a 'CmmStatic'.
 lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
 lower_CmmStatic s = case s of
-  CmmStaticLit (CmmInt i W8) -> pure $ DataI8 $ naturalNarrowing W8 i
-  CmmStaticLit (CmmInt i W16) -> pure $ DataI16 $ naturalNarrowing W16 i
-  CmmStaticLit (CmmInt i W32) -> pure $ DataI32 $ naturalNarrowing W32 i
-  CmmStaticLit (CmmInt i W64) -> pure $ DataI64 $ naturalNarrowing W64 i
+  CmmStaticLit (CmmInt i W8) -> pure $ DataI8 $ fromInteger $ narrowU W8 i
+  CmmStaticLit (CmmInt i W16) -> pure $ DataI16 $ fromInteger $ narrowU W16 i
+  CmmStaticLit (CmmInt i W32) -> pure $ DataI32 $ fromInteger $ narrowU W32 i
+  CmmStaticLit (CmmInt i W64) -> pure $ DataI64 $ fromInteger $ narrowU W64 i
   CmmStaticLit (CmmFloat f W32) -> pure $ DataF32 $ fromRational f
   CmmStaticLit (CmmFloat d W64) -> pure $ DataF64 $ fromRational d
   CmmStaticLit (CmmLabel lbl) ->
@@ -831,7 +831,7 @@ lower_CmmLit lit = do
           SomeWasmExpr ty $
             WasmExpr $
               WasmConst ty $
-                naturalNarrowing w i
+                narrowU w i
     CmmFloat f W32 ->
       pure $
         SomeWasmExpr TagF32 $
diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs
index 284d62b173..50b1234f30 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Types.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs
@@ -57,6 +57,7 @@ import qualified Data.IntSet as IS
 import Data.Kind
 import Data.String
 import Data.Type.Equality
+import Data.Word
 import GHC.Cmm
 import GHC.Data.FastString
 import GHC.Float
@@ -174,10 +175,10 @@ data DataSectionKind = SectionData | SectionROData
 -- account, therefore we always round up a 'CmmLit' to the right width
 -- and handle it as an untyped integer.
 data DataSectionContent
-  = DataI8 Integer
-  | DataI16 Integer
-  | DataI32 Integer
-  | DataI64 Integer
+  = DataI8 Word8
+  | DataI16 Word16
+  | DataI32 Word32
+  | DataI64 Word64
   | DataF32 Float
   | DataF64 Double
   | DataSym SymName Int
diff --git a/compiler/GHC/CmmToAsm/Wasm/Utils.hs b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
index b794c7f5b7..61dfc9bfb2 100644
--- a/compiler/GHC/CmmToAsm/Wasm/Utils.hs
+++ b/compiler/GHC/CmmToAsm/Wasm/Utils.hs
@@ -2,8 +2,7 @@
 {-# LANGUAGE Strict #-}
 
 module GHC.CmmToAsm.Wasm.Utils
-  ( naturalNarrowing,
-    widthMax,
+  ( widthMax,
     detEltsUFM,
     detEltsUniqMap,
     builderCommas,
@@ -17,11 +16,6 @@ import GHC.Prelude
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Map
 
-naturalNarrowing :: Width -> Integer -> Integer
-naturalNarrowing w i
-  | i < 0 = narrowS w i
-  | otherwise = narrowU w i
-
 widthMax :: Width -> Integer
 widthMax w = (1 `shiftL` widthInBits w) - 1