Fix toArgRep to support 64-bit reps on all systems

[This is @Ericson2314 writing a commit message for @hsyl20's patch.]

(Progress towards #11953, #17377, #17375)

`Int64Rep` and `Word64Rep` are currently broken on 64-bit systems.  This
is because they should use "native arg rep" but instead use "large arg
rep" as they do on 32-bit systems, which is either a non-concept or a
128-bit rep depending on one's vantage point.

Now, these reps currently aren't used during 64-bit compilation, so the
brokenness isn't observed, but I don't think that constitutes reasons
not to fix it. Firstly, the linked issues there is a clearly expressed
desire to use explicit-bitwidth constructs in more places. Secondly, per
[1], there are other bugs that *do* manifest from not threading
explicit-bitwidth information all the way through the compilation
pipeline. One can therefore view this as one piece of the larger effort
to do that, improve ergnomics, and squash remaining bugs.

Also, this is needed for !3658. I could just merge this as part of that,
but I'm keen on merging fixes "as they are ready" so the fixes that
aren't ready are isolated and easier to debug.

[1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html

3 files changed, 39 insertions, 31 deletions

diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index 4d85d23d17..8fc1796d6f 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -65,28 +65,33 @@ argRepString V16 = "V16"
 argRepString V32 = "V32"
 argRepString V64 = "V64"
 
-toArgRep :: PrimRep -> ArgRep
-toArgRep VoidRep           = V
-toArgRep LiftedRep         = P
-toArgRep UnliftedRep       = P
-toArgRep IntRep            = N
-toArgRep WordRep           = N
-toArgRep Int8Rep           = N  -- Gets widened to native word width for calls
-toArgRep Word8Rep          = N  -- Gets widened to native word width for calls
-toArgRep Int16Rep          = N  -- Gets widened to native word width for calls
-toArgRep Word16Rep         = N  -- Gets widened to native word width for calls
-toArgRep Int32Rep          = N  -- Gets widened to native word width for calls
-toArgRep Word32Rep         = N  -- Gets widened to native word width for calls
-toArgRep AddrRep           = N
-toArgRep Int64Rep          = L
-toArgRep Word64Rep         = L
-toArgRep FloatRep          = F
-toArgRep DoubleRep         = D
-toArgRep (VecRep len elem) = case len*primElemRepSizeB elem of
-                               16 -> V16
-                               32 -> V32
-                               64 -> V64
-                               _  -> error "toArgRep: bad vector primrep"
+toArgRep :: Platform -> PrimRep -> ArgRep
+toArgRep platform rep = case rep of
+   VoidRep           -> V
+   LiftedRep         -> P
+   UnliftedRep       -> P
+   IntRep            -> N
+   WordRep           -> N
+   Int8Rep           -> N  -- Gets widened to native word width for calls
+   Word8Rep          -> N  -- Gets widened to native word width for calls
+   Int16Rep          -> N  -- Gets widened to native word width for calls
+   Word16Rep         -> N  -- Gets widened to native word width for calls
+   Int32Rep          -> N  -- Gets widened to native word width for calls
+   Word32Rep         -> N  -- Gets widened to native word width for calls
+   AddrRep           -> N
+   Int64Rep          -> case platformWordSize platform of
+                           PW4 -> L
+                           PW8 -> N
+   Word64Rep         -> case platformWordSize platform of
+                           PW4 -> L
+                           PW8 -> N
+   FloatRep          -> F
+   DoubleRep         -> D
+   (VecRep len elem) -> case len*primElemRepSizeB elem of
+                           16 -> V16
+                           32 -> V32
+                           64 -> V64
+                           _  -> error "toArgRep: bad vector primrep"
 
 isNonV :: ArgRep -> Bool
 isNonV V = False
@@ -106,8 +111,8 @@ argRepSizeW platform = \case
   where
    ws       = platformWordSizeInBytes platform
 
-idArgRep :: Id -> ArgRep
-idArgRep = toArgRep . idPrimRep
+idArgRep :: Platform -> Id -> ArgRep
+idArgRep platform = toArgRep platform . idPrimRep
 
 -- This list of argument patterns should be kept in sync with at least
 -- the following:
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 70a9fc8fe7..88e77b3782 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -321,12 +321,14 @@ direct_call caller call_conv lbl arity args
 -- using zeroCLit or even undefined would work, but would be ugly).
 --
 getArgRepsAmodes :: [StgArg] -> FCode [(ArgRep, Maybe CmmExpr)]
-getArgRepsAmodes = mapM getArgRepAmode
-  where getArgRepAmode arg
+getArgRepsAmodes args = do
+   platform <- profilePlatform <$> getProfile
+   mapM (getArgRepAmode platform) args
+  where getArgRepAmode platform arg
            | V <- rep  = return (V, Nothing)
            | otherwise = do expr <- getArgAmode (NonVoid arg)
                             return (rep, Just expr)
-           where rep = toArgRep (argPrimRep arg)
+           where rep = toArgRep platform (argPrimRep arg)
 
 nonVArgs :: [(ArgRep, Maybe CmmExpr)] -> [CmmExpr]
 nonVArgs [] = []
@@ -542,7 +544,7 @@ mkVirtConstrSizes profile field_reps
 mkArgDescr :: Platform -> [Id] -> ArgDescr
 mkArgDescr platform args
   = let arg_bits = argBits platform arg_reps
-        arg_reps = filter isNonV (map idArgRep args)
+        arg_reps = filter isNonV (map (idArgRep platform) args)
            -- Getting rid of voids eases matching of standard patterns
     in case stdPattern arg_reps of
          Just spec_id -> ArgSpec spec_id
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index b7f43665cd..44a99a0cae 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -409,10 +409,11 @@ tickySlowCall lf_info args = do
  tickySlowCallPat (map argPrimRep args)
 
 tickySlowCallPat :: [PrimRep] -> FCode ()
-tickySlowCallPat args = ifTicky $
-  let argReps = map toArgRep args
+tickySlowCallPat args = ifTicky $ do
+  platform <- profilePlatform <$> getProfile
+  let argReps = map (toArgRep platform) args
       (_, n_matched) = slowCallPattern argReps
-  in if n_matched > 0 && args `lengthIs` n_matched
+  if n_matched > 0 && args `lengthIs` n_matched
      then bumpTickyLbl $ mkRtsSlowFastTickyCtrLabel $ concatMap (map Data.Char.toLower . argRepString) argReps
      else bumpTickyCounter $ fsLit "VERY_SLOW_CALL_ctr"