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>

4 files changed, 56 insertions, 24 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)]