[debug only] warn on hint/arg mismatch

1 files changed, 16 insertions, 0 deletions

diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 7e5fc0a9dc..e082b9a8a7 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -54,6 +54,10 @@ import GHC.Utils.Misc (zipEqual)
 
 import Control.Monad
 
+import Debug.Trace
+import GHC.Utils.Outputable (ppr)
+import GHC.Driver.Ppr (showPprUnsafe)
+
 -----------------------------------------------------------------------------
 -- Code generation for Foreign Calls
 -----------------------------------------------------------------------------
@@ -82,6 +86,7 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_ty
             arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType platform arg)
                                      (platformWordSizeInBytes platform)
         ; cmm_args <- getFCallArgs stg_args typ
+        -- ; traceM $ show cmm_args
         ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
         ; let ((call_args, arg_hints), cmm_target)
                 = case target of
@@ -103,6 +108,17 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) typ stg_args res_ty
               fc = ForeignConvention cconv arg_hints res_hints CmmMayReturn
               call_target = ForeignTarget cmm_target fc
 
+        ; forM cmm_args $ \arg -> case arg of
+            (CmmLit _, AddrHint) -> pure ()
+            (CmmReg _, AddrHint) -> pure ()
+            (CmmRegOff _ _, AddrHint) -> pure ()
+            (CmmLit (CmmInt _ w), SignedHint w')              | w == w' -> pure ()
+            (CmmLit (CmmInt _ w), NoHint w')                  | w == w' -> pure ()
+            (CmmReg (CmmLocal (LocalReg _ ty)), _)            | isFloatType ty -> pure ()
+            (CmmReg (CmmLocal (LocalReg _ ty)), SignedHint w) | isBitsType ty && typeWidth ty == w -> pure ()
+            (CmmReg (CmmLocal (LocalReg _ ty)), NoHint w)     | isBitsType ty && typeWidth ty == w -> pure ()
+            arg -> traceM $ show cmm_args ++ "\n\t" ++ show arg ++ "; sized don't match! in" ++ "\n\t" ++ showPprUnsafe (ppr cmm_target)
+
         -- we want to emit code for the call, and then emitReturn.
         -- However, if the sequel is AssignTo, we shortcut a little
         -- and generate a foreign call that assigns the results