Try to do more fixed-size `Int64#` and `Word64#`wip/prep-int64

We still have lots of CPP, but we are trying to make the 64-bit ones
more ready.

Co-authored-by: Sylvain Henry <hsyl20@gmail.com>

10 files changed, 115 insertions, 62 deletions

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index b2a45ad79f..868837d5b1 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -584,9 +584,7 @@ primop Word32NeOp "neWord32#" Compare Word32# -> Word32# -> Int#
 
 ------------------------------------------------------------------------
 section "Int64#"
-        {Operations on 64-bit unsigned words. This type is only used
-         if plain {\tt Int\#} has less than 64 bits. In any case, the operations
-         are not primops; they are implemented (if needed) as ccalls instead.}
+        {Operations on 64-bit integers.}
 ------------------------------------------------------------------------
 
 primtype Int64#
@@ -614,6 +612,10 @@ primop Int64RemOp "remInt64#" GenPrimOp Int64# -> Int64# -> Int64#
   with
     can_fail = True
 
+primop Int64QuotRemOp "quotRemInt64#" GenPrimOp Int64# -> Int64# -> (# Int64#, Int64# #)
+  with
+    can_fail = True
+
 primop Int64SllOp "uncheckedIShiftL64#"  GenPrimOp Int64# -> Int# -> Int64#
 primop Int64SraOp "uncheckedIShiftRA64#" GenPrimOp Int64# -> Int# -> Int64#
 primop Int64SrlOp "uncheckedIShiftRL64#" GenPrimOp Int64# -> Int# -> Int64#
@@ -630,9 +632,7 @@ primop Int64NeOp "neInt64#" Compare Int64# -> Int64# -> Int#
 
 ------------------------------------------------------------------------
 section "Word64#"
-        {Operations on 64-bit unsigned words. This type is only used
-         if plain {\tt Word\#} has less than 64 bits. In any case, the operations
-         are not primops; they are implemented (if needed) as ccalls instead.}
+        {Operations on 64-bit unsigned words.}
 ------------------------------------------------------------------------
 
 primtype Word64#
@@ -658,6 +658,10 @@ primop Word64RemOp "remWord64#" GenPrimOp Word64# -> Word64# -> Word64#
   with
     can_fail = True
 
+primop Word64QuotRemOp "quotRemWord64#" GenPrimOp Word64# -> Word64# -> (# Word64#, Word64# #)
+  with
+    can_fail = True
+
 primop Word64AndOp "and64#" GenPrimOp Word64# -> Word64# -> Word64#
    with commutable = True
 
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index cce8830a97..4c4fbf4d01 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -567,7 +567,8 @@ primOpRules nm = \case
                                        , narrowSubsumesAnd IntAndOp IntToInt16Op 16 ]
    IntToInt32Op   -> mkPrimOpRule nm 1 [ liftLit narrowInt32Lit
                                        , narrowSubsumesAnd IntAndOp IntToInt32Op 32 ]
-   IntToInt64Op   -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ]
+   IntToInt64Op   -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit
+                                       , narrowSubsumesAnd IntAndOp IntToInt64Op 64 ]
 
    Word8ToWordOp  -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
                                        , extendNarrowPassthrough WordToWord8Op 0xFF
@@ -578,15 +579,17 @@ primOpRules nm = \case
    Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
                                        , extendNarrowPassthrough WordToWord32Op 0xFFFFFFFF
                                        ]
-   Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit ]
-
+   Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform convertToWordLit
+                                       , extendNarrowPassthrough WordToWord64Op 0xFFFFFFFFFFFFFFFF
+                                       ]
    WordToWord8Op  -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit
                                        , narrowSubsumesAnd WordAndOp WordToWord8Op 8 ]
    WordToWord16Op -> mkPrimOpRule nm 1 [ liftLit narrowWord16Lit
                                        , narrowSubsumesAnd WordAndOp WordToWord16Op 16 ]
    WordToWord32Op -> mkPrimOpRule nm 1 [ liftLit narrowWord32Lit
                                        , narrowSubsumesAnd WordAndOp WordToWord32Op 32 ]
-   WordToWord64Op -> mkPrimOpRule nm 1 [ liftLit narrowWord64Lit ]
+   WordToWord64Op -> mkPrimOpRule nm 1 [ liftLit narrowWord64Lit
+                                       , narrowSubsumesAnd WordAndOp WordToWord64Op 64 ]
 
    Word8ToInt8Op  -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt8) ]
    Int8ToWord8Op  -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord8) ]
@@ -1215,6 +1218,14 @@ int32Result result = Just (int32Result' result)
 int32Result' :: Integer -> CoreExpr
 int32Result' result = Lit (mkLitInt32Wrap result)
 
+int64Result :: Integer -> Maybe CoreExpr
+int64Result result = Just (int64Result' result)
+
+int64Result' :: Integer -> CoreExpr
+int64Result' result = Lit (mkLitInt64Wrap result)
+
+-- | Create an Int literal expression while ensuring the given Integer is in the
+-- target Int range
 intResult :: Platform -> Integer -> Maybe CoreExpr
 intResult platform result = Just (intResult' platform result)
 
@@ -1257,6 +1268,14 @@ word32Result' result = Lit (mkLitWord32Wrap result)
 
 -- | Create a Word literal expression while ensuring the given Integer is in the
 -- target Word range
+word64Result :: Integer -> Maybe CoreExpr
+word64Result result = Just (word64Result' result)
+
+word64Result' :: Integer -> CoreExpr
+word64Result' result = Lit (mkLitWord64Wrap result)
+
+-- | Create a Word literal expression while ensuring the given Integer is in the
+-- target Word range
 wordResult :: Platform -> Integer -> Maybe CoreExpr
 wordResult platform result = Just (wordResult' platform result)
 
@@ -1273,19 +1292,6 @@ wordCResult platform result = Just (mkPair [Lit lit, Lit c])
     (lit, b) = mkLitWordWrapC platform result
     c = if b then onei platform else zeroi platform
 
-int64Result :: Integer -> Maybe CoreExpr
-int64Result result = Just (int64Result' result)
-
-int64Result' :: Integer -> CoreExpr
-int64Result' result = Lit (mkLitInt64Wrap result)
-
-word64Result :: Integer -> Maybe CoreExpr
-word64Result result = Just (word64Result' result)
-
-word64Result' :: Integer -> CoreExpr
-word64Result' result = Lit (mkLitWord64Wrap result)
-
-
 -- | 'ambiant (primop x) = x', but not nececesarily 'primop (ambient x) = x'.
 semiInversePrimOp :: PrimOp -> RuleM CoreExpr
 semiInversePrimOp primop = do
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index c8a2ba8aad..446927daeb 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1500,6 +1500,11 @@ emitPrimOp dflags primop = case primop of
     then Left (MO_S_QuotRem W32)
     else Right (genericIntQuotRemOp W32)
 
+  Int64QuotRemOp -> \args -> opCallishHandledLater args $
+    if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+    then Left (MO_S_QuotRem W64)
+    else Right (genericIntQuotRemOp W64)
+
   WordQuotRemOp -> \args -> opCallishHandledLater args $
     if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
     then Left (MO_U_QuotRem  (wordWidth platform))
@@ -1525,6 +1530,11 @@ emitPrimOp dflags primop = case primop of
     then Left (MO_U_QuotRem W32)
     else Right (genericWordQuotRemOp W32)
 
+  Word64QuotRemOp -> \args -> opCallishHandledLater args $
+    if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+    then Left (MO_U_QuotRem W64)
+    else Right (genericWordQuotRemOp W64)
+
   WordAdd2Op -> \args -> opCallishHandledLater args $
     if (ncg && (x86ish || ppc)) || llvm
     then Left (MO_Add2       (wordWidth platform))
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index a061674af9..054d4a1fa1 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1507,7 +1507,8 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstrTag_RDR,
     eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
     word8ToWord_RDR , int8ToInt_RDR ,
     word16ToWord_RDR, int16ToInt_RDR,
-    word32ToWord_RDR, int32ToInt_RDR
+    word32ToWord_RDR, int32ToInt_RDR,
+    word64ToWord_RDR, int64ToInt_RDR
     :: RdrName
 gfoldl_RDR     = varQual_RDR  gENERICS (fsLit "gfoldl")
 gunfold_RDR    = varQual_RDR  gENERICS (fsLit "gunfold")
@@ -1618,6 +1619,9 @@ int16ToInt_RDR   = varQual_RDR  gHC_PRIM (fsLit "int16ToInt#")
 word32ToWord_RDR = varQual_RDR  gHC_PRIM (fsLit "word32ToWord#")
 int32ToInt_RDR   = varQual_RDR  gHC_PRIM (fsLit "int32ToInt#")
 
+word64ToWord_RDR = varQual_RDR  gHC_PRIM (fsLit "word64ToWord#")
+int64ToInt_RDR   = varQual_RDR  gHC_PRIM (fsLit "int64ToInt#")
+
 {-
 ************************************************************************
 *                                                                      *
@@ -2428,6 +2432,12 @@ boxConTbl =
     , (word32PrimTy,
         nlHsApp (nlHsVar $ getRdrName wordDataCon)
         . nlHsApp (nlHsVar word32ToWord_RDR))
+    , (int64PrimTy,
+        nlHsApp (nlHsVar $ getRdrName intDataCon)
+        . nlHsApp (nlHsVar int64ToInt_RDR))
+    , (word64PrimTy,
+        nlHsApp (nlHsVar $ getRdrName wordDataCon)
+        . nlHsApp (nlHsVar word64ToWord_RDR))
     ]
 
 
@@ -2455,6 +2465,8 @@ primConvTbl =
     , (word16PrimTy, "wordToWord16#")
     , (int32PrimTy, "intToInt32#")
     , (word32PrimTy, "wordToWord32#")
+    , (int64PrimTy, "intToInt64#")
+    , (word64PrimTy, "wordToWord64#")
     ]
 
 litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs
index b5c5530688..84ef2b06fe 100644
--- a/libraries/base/GHC/Int.hs
+++ b/libraries/base/GHC/Int.hs
@@ -825,30 +825,6 @@ instance Integral Int64 where
 #endif
     toInteger (I64# x)               = integerFromInt64# x
 
-
-divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
-
--- Define div in terms of quot, being careful to avoid overflow (#7233)
-x# `divInt64#` y#
-    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero)
-        = ((x# `subInt64#` one) `quotInt64#` y#) `subInt64#` one
-    | isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
-        = ((x# `plusInt64#` one)  `quotInt64#` y#) `subInt64#` one
-    | otherwise
-        = x# `quotInt64#` y#
-    where
-    !zero = intToInt64# 0#
-    !one  = intToInt64# 1#
-
-x# `modInt64#` y#
-    | isTrue# (x# `gtInt64#` zero) && isTrue# (y# `ltInt64#` zero) ||
-      isTrue# (x# `ltInt64#` zero) && isTrue# (y# `gtInt64#` zero)
-        = if isTrue# (r# `neInt64#` zero) then r# `plusInt64#` y# else zero
-    | otherwise = r#
-    where
-    !zero = intToInt64# 0#
-    !r# = x# `remInt64#` y#
-
 -- | @since 2.01
 instance Read Int64 where
     readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
diff --git a/libraries/ghc-prim/GHC/Classes.hs b/libraries/ghc-prim/GHC/Classes.hs
index 13e9556864..a79954c132 100644
--- a/libraries/ghc-prim/GHC/Classes.hs
+++ b/libraries/ghc-prim/GHC/Classes.hs
@@ -51,9 +51,9 @@ module GHC.Classes(
     (&&), (||), not,
 
     -- * Integer arithmetic
-    divInt#, divInt8#, divInt16#, divInt32#,
-    modInt#, modInt8#, modInt16#, modInt32#,
-    divModInt#, divModInt8#, divModInt16#, divModInt32#
+    divInt#, divInt8#, divInt16#, divInt32#, divInt64#,
+    modInt#, modInt8#, modInt16#, modInt32#, modInt64#,
+    divModInt#, divModInt8#, divModInt16#, divModInt32#, divModInt64#
  ) where
 
 -- GHC.Magic is used in some derived instances
@@ -585,6 +585,21 @@ x# `divInt32#` y# = ((x# `plusInt32#` bias#) `quotInt32#` y#) `subInt32#` hard#
       !bias# = c0# `subInt32#` c1#
       !hard# = c0# `orInt32#` c1#
 
+{-# INLINE [0] divInt64# #-}
+divInt64# :: Int64# -> Int64# -> Int64#
+x# `divInt64#` y# = ((x# `plusInt64#` bias#) `quotInt64#` y#) `subInt64#` hard#
+   where
+      zero# = intToInt64# 0#
+      x `andInt64#` y = word64ToInt64# (int64ToWord64# x `and64#` int64ToWord64# y)
+      x `orInt64#` y = word64ToInt64# (int64ToWord64# x `or64#` int64ToWord64# y)
+      notInt64# x = word64ToInt64# (not64# (int64ToWord64# x))
+      -- See Note [divInt# implementation]
+      !yn#   = intToInt64# (y# `ltInt64#` zero#)
+      !c0#   = intToInt64# (x# `ltInt64#` zero#) `andInt64#` (notInt64# yn#)
+      !c1#   = intToInt64# (x# `gtInt64#` zero#) `andInt64#` yn#
+      !bias# = c0# `subInt64#` c1#
+      !hard# = c0# `orInt64#` c1#
+
 -- Note [divInt# implementation]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -703,6 +718,22 @@ x# `modInt32#` y# = r# `plusInt32#` k#
     !k#  = s# `andInt32#` y#
     !r#  = x# `remInt32#` y#
 
+{-# INLINE [0] modInt64# #-}
+modInt64# :: Int64# -> Int64# -> Int64#
+x# `modInt64#` y# = r# `plusInt64#` k#
+  where
+    zero# = intToInt64# 0#
+    x `andInt64#` y = word64ToInt64# (int64ToWord64# x `and64#` int64ToWord64# y)
+    x `orInt64#` y = word64ToInt64# (int64ToWord64# x `or64#` int64ToWord64# y)
+    notInt64# x = word64ToInt64# (not64# (int64ToWord64# x))
+    -- See Note [modInt# implementation]
+    !yn# = intToInt64# (y# `ltInt64#` zero#)
+    !c0# = intToInt64# (x# `ltInt64#` zero#) `andInt64#` (notInt64# yn#)
+    !c1# = intToInt64# (x# `gtInt64#` zero#) `andInt64#` yn#
+    !s#  = zero# `subInt64#` ((c0# `orInt64#` c1#) `andInt64#` (intToInt64# (r# `neInt64#` zero#)))
+    !k#  = s# `andInt64#` y#
+    !r#  = x# `remInt64#` y#
+
 -- Note [modInt# implementation]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
@@ -821,6 +852,24 @@ x# `divModInt32#` y# = case (x# `plusInt32#` bias#) `quotRemInt32#` y# of
     !s#    = zero# `subInt32#` hard#
     !k#    = (s# `andInt32#` y#) `subInt32#` bias#
 
+{-# INLINE [0] divModInt64# #-}
+divModInt64# :: Int64# -> Int64# -> (# Int64#, Int64# #)
+x# `divModInt64#` y# = case (x# `plusInt64#` bias#) `quotRemInt64#` y# of
+  (# q#, r# #) -> (# q# `subInt64#` hard#, r# `plusInt64#` k# #)
+  where
+    zero# = intToInt64# 0#
+    x `andInt64#` y = word64ToInt64# (int64ToWord64# x `and64#` int64ToWord64# y)
+    x `orInt64#` y = word64ToInt64# (int64ToWord64# x `or64#` int64ToWord64# y)
+    notInt64# x = word64ToInt64# (not64# (int64ToWord64# x))
+    -- See Note [divModInt# implementation]
+    !yn#   = intToInt64# (y# `ltInt64#` zero#)
+    !c0#   = intToInt64# (x# `ltInt64#` zero#) `andInt64#` (notInt64# yn#)
+    !c1#   = intToInt64# (x# `gtInt64#` zero#) `andInt64#` yn#
+    !bias# = c0# `subInt64#` c1#
+    !hard# = c0# `orInt64#` c1#
+    !s#    = zero# `subInt64#` hard#
+    !k#    = (s# `andInt64#` y#) `subInt64#` bias#
+
 -- Note [divModInt# implementation]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 9d721e44e9..1ec4101079 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -57,16 +57,16 @@ T9509:
 
 T13317:
 	$(RM) -f T13317.o T13317.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl-stats T13317.hs | grep 'KnownBranch'
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl-stats T13317.hs | grep 'KnownBranch'
 
 T13367:
 	$(RM) -f T13317.o T13317.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl -dsuppress-ticks T13367.hs | grep 'foo'
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-ticks T13367.hs | grep 'foo'
         # There should be only one copy of the string "foo"#
 
 T8832:
 	$(RM) -f T8832.o T8832.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) $(T8832_WORDSIZE_OPTS) -O -c -ddump-simpl -dsuppress-ticks T8832.hs | grep '^[a-zA-Z0-9]\+ ='
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-ticks T8832.hs | grep '^[a-zA-Z0-9]\+ ='
 
 T12603:
 	$(RM) -f T12603.o T12603.hi
diff --git a/testsuite/tests/simplCore/should_compile/T8832.hs b/testsuite/tests/simplCore/should_compile/T8832.hs
index 0cbff6976b..227eee1f51 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.hs
+++ b/testsuite/tests/simplCore/should_compile/T8832.hs
@@ -17,16 +17,12 @@ T(i,Int)
 T(i8,Int8)
 T(i16,Int16)
 T(i32,Int32)
-#if defined(T8832_WORDSIZE_64)
 T(i64,Int64)
-#endif
 
 T(w,Word)
 T(w8,Word8)
 T(w16,Word16)
 T(w32,Word32)
-#if defined(T8832_WORDSIZE_64)
 T(w64,Word64)
-#endif
 
 T(z,Integer)
diff --git a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32 b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
index 53b2c046c1..e99bbde15b 100644
--- a/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
+++ b/testsuite/tests/simplCore/should_compile/T8832.stdout-ws-32
@@ -2,8 +2,10 @@ i = GHC.Types.I# 0#
 i8 = GHC.Int.I8# 0#8
 i16 = GHC.Int.I16# 0#16
 i32 = GHC.Int.I32# 0#32
+i64 = GHC.Int.I64# 0#64
 w = GHC.Types.W# 0##
 w8 = GHC.Word.W8# 0##8
 w16 = GHC.Word.W16# 0##16
 w32 = GHC.Word.W32# 0##32
+w64 = GHC.Word.W64# 0##64
 z = GHC.Num.Integer.IS 0#
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index d500b5364a..479440a0ce 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -170,10 +170,8 @@ test('T5996',
      normal,
      makefile_test, ['T5996'])
 test('T8537', normal, compile, [''])
-test('T8832',
-     normal,
-     run_command, ['$MAKE -s --no-print-directory T8832 T8832_WORDSIZE_OPTS=' +
-      ('-DT8832_WORDSIZE_64' if wordsize(64) else '')])
+test('T8832', normal,
+     makefile_test, ['T8832'])
 test('T8848', normal,
      makefile_test, ['T8848'])
 test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules'])