{-
This module contains helpers to cast variables
between different Int/WordReps in StgLand.

-}

module GHC.Builtin.PrimOps.Casts
    ( getCasts )
where

import GHC.Prelude

import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.RepType
import GHC.Core.Type
import GHC.Builtin.Types.Prim

import GHC.Builtin.PrimOps
import GHC.Plugins (HasDebugCallStack)

{- Note [PrimRep based casting]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This module contains a number of utility functions useful when
converting between variables of differing PrimReps.

The general pattern is:
* We have two primReps `from_rep` and `to_rep`.
* We want a list of PrimOps we can apply to a variable of rep `from_rep`.
Applying the list of primOps in order takes us to `to_rep` from `from_rep` giving
us a variable of the returned type at each step.

E.g. we call `getCasts from_rep to_rep` and get back [(op1#,ty1),(op2#,ty2)].
We can use this result to construct a function of type
`StgExpr -> StgExpr` by construction an expression

    case op1# <from> of (x' :: ty1) -> case op2# x' of x' -> <rhs_hole>

Ideally backends will compile the sequence of PrimOps to a no-op. E.g. by reusing
the same register but just relabeling it as another width.
However this is might not always be possible or the required optimizations
simply not implemented in the backend. This means currently many of these casts
will be cheap but not all of them will be completely zero-cost.

-}

-- | `getCasts from_rep to_rep` gives us a list of primops which when applied in order convert from_rep to to_rep.
-- See Note [PrimRep based casting]
getCasts :: PrimRep -> PrimRep -> [(PrimOp,Type)]
getCasts :: PrimRep -> PrimRep -> [(PrimOp, Type)]
getCasts PrimRep
from_rep PrimRep
to_rep
  -- No-op
  | -- pprTrace "getCasts" (ppr (from_rep,to_rep)) $
    PrimRep
to_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
from_rep
  = []

  -- Float <-> Double
  | PrimRep
to_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
FloatRep =
    Bool -> SDoc -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (PrimRep
from_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
DoubleRep) (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
from_rep SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
to_rep) ([(PrimOp, Type)] -> [(PrimOp, Type)])
-> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a b. (a -> b) -> a -> b
$
    [(PrimOp
DoubleToFloatOp,Type
floatPrimTy)]
  | PrimRep
to_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
DoubleRep =
    Bool -> SDoc -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (PrimRep
from_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
FloatRep) (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
from_rep SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
to_rep) ([(PrimOp, Type)] -> [(PrimOp, Type)])
-> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a b. (a -> b) -> a -> b
$
    [(PrimOp
FloatToDoubleOp,Type
doublePrimTy)]

  -- Addr <-> Word/Int
  | PrimRep
to_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
AddrRep = HasDebugCallStack => PrimRep -> [(PrimOp, Type)]
PrimRep -> [(PrimOp, Type)]
wordOrIntToAddrRep PrimRep
from_rep
  | PrimRep
from_rep PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
AddrRep = HasDebugCallStack => PrimRep -> [(PrimOp, Type)]
PrimRep -> [(PrimOp, Type)]
addrToWordOrIntRep PrimRep
to_rep

  -- Int* -> Int*
  | PrimRep -> Bool
primRepIsInt PrimRep
from_rep
  , PrimRep -> Bool
primRepIsInt PrimRep
to_rep
  = HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedIntToSizedInt PrimRep
from_rep PrimRep
to_rep

  -- Word* -> Word*
  | PrimRep -> Bool
primRepIsWord PrimRep
from_rep
  , PrimRep -> Bool
primRepIsWord PrimRep
to_rep
  = HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedWordToSizedWord PrimRep
from_rep PrimRep
to_rep

  -- Word* -> Int*
  | PrimRep -> Bool
primRepIsWord PrimRep
from_rep
  , PrimRep -> Bool
primRepIsInt PrimRep
to_rep
  = let (PrimOp
op1,PrimRep
r1) = HasDebugCallStack => PrimRep -> (PrimOp, PrimRep)
PrimRep -> (PrimOp, PrimRep)
wordToIntRep PrimRep
from_rep
    in (PrimOp
op1,PrimRep -> Type
primRepToType PrimRep
r1)(PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
:HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedIntToSizedInt PrimRep
r1 PrimRep
to_rep

  -- Int* -> Word*
  | PrimRep -> Bool
primRepIsInt PrimRep
from_rep
  , PrimRep -> Bool
primRepIsWord PrimRep
to_rep
  = let (PrimOp
op1,PrimRep
r1) = HasDebugCallStack => PrimRep -> (PrimOp, PrimRep)
PrimRep -> (PrimOp, PrimRep)
intToWordRep PrimRep
from_rep
    in (PrimOp
op1,PrimRep -> Type
primRepToType PrimRep
r1)(PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
:HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedWordToSizedWord PrimRep
r1 PrimRep
to_rep

  | Bool
otherwise = String -> SDoc -> [(PrimOp, Type)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getCasts:Unexpect rep combination"
                          ((PrimRep, PrimRep) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (PrimRep
from_rep,PrimRep
to_rep))

wordOrIntToAddrRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]
wordOrIntToAddrRep :: HasDebugCallStack => PrimRep -> [(PrimOp, Type)]
wordOrIntToAddrRep PrimRep
AddrRep = [] -- No-op argument is already AddrRep
wordOrIntToAddrRep PrimRep
IntRep = [(PrimOp
IntToAddrOp, Type
addrPrimTy)]
wordOrIntToAddrRep PrimRep
WordRep = [(PrimOp
WordToIntOp,Type
intPrimTy), (PrimOp
IntToAddrOp,Type
addrPrimTy)]
wordOrIntToAddrRep PrimRep
r
    | PrimRep -> Bool
primRepIsInt PrimRep
r = (HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intToMachineInt PrimRep
r,Type
intPrimTy)(PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
:[(PrimOp
IntToAddrOp,Type
addrPrimTy)]
    | PrimRep -> Bool
primRepIsWord PrimRep
r =
        let (PrimOp
op1,PrimRep
r1) = HasDebugCallStack => PrimRep -> (PrimOp, PrimRep)
PrimRep -> (PrimOp, PrimRep)
wordToIntRep PrimRep
r
        in (PrimOp
op1, PrimRep -> Type
primRepToType PrimRep
r1)(PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
:[(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intToMachineInt PrimRep
r1,Type
intPrimTy), (PrimOp
IntToAddrOp,Type
addrPrimTy)]
    | Bool
otherwise = String -> SDoc -> [(PrimOp, Type)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Rep not word or int rep" (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r)

addrToWordOrIntRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]
-- Machine sizes
addrToWordOrIntRep :: HasDebugCallStack => PrimRep -> [(PrimOp, Type)]
addrToWordOrIntRep PrimRep
IntRep = [(PrimOp
AddrToIntOp, Type
intPrimTy)]
addrToWordOrIntRep PrimRep
WordRep = [(PrimOp
AddrToIntOp,Type
intPrimTy), (PrimOp
IntToWordOp,Type
wordPrimTy)]
-- Explicitly sized reps
addrToWordOrIntRep PrimRep
r
    | PrimRep -> Bool
primRepIsWord PrimRep
r = (PrimOp
AddrToIntOp,Type
intPrimTy) (PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
: (PrimOp
IntToWordOp,Type
wordPrimTy) (PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedWordToSizedWord PrimRep
WordRep PrimRep
r
    | PrimRep -> Bool
primRepIsInt PrimRep
r = (PrimOp
AddrToIntOp,Type
intPrimTy) (PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedIntToSizedInt PrimRep
IntRep PrimRep
r
    | Bool
otherwise = String -> SDoc -> [(PrimOp, Type)]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Target rep not word or int rep" (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r)


-- WordX# -> IntX# (same size), argument is source rep
wordToIntRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)
wordToIntRep :: HasDebugCallStack => PrimRep -> (PrimOp, PrimRep)
wordToIntRep PrimRep
rep
    = case PrimRep
rep of
        (PrimRep
WordRep) -> (PrimOp
WordToIntOp, PrimRep
IntRep)
        (PrimRep
Word8Rep) -> (PrimOp
Word8ToInt8Op, PrimRep
Int8Rep)
        (PrimRep
Word16Rep) -> (PrimOp
Word16ToInt16Op, PrimRep
Int16Rep)
        (PrimRep
Word32Rep) -> (PrimOp
Word32ToInt32Op, PrimRep
Int32Rep)
        (PrimRep
Word64Rep) -> (PrimOp
Word64ToInt64Op, PrimRep
Int64Rep)
        PrimRep
_ -> String -> SDoc -> (PrimOp, PrimRep)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Rep not a wordRep" (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
rep)

-- IntX# -> WordX#, argument is source rep
intToWordRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)
intToWordRep :: HasDebugCallStack => PrimRep -> (PrimOp, PrimRep)
intToWordRep PrimRep
rep
    = case PrimRep
rep of
        (PrimRep
IntRep) -> (PrimOp
IntToWordOp, PrimRep
WordRep)
        (PrimRep
Int8Rep) -> (PrimOp
Int8ToWord8Op, PrimRep
Word8Rep)
        (PrimRep
Int16Rep) -> (PrimOp
Int16ToWord16Op, PrimRep
Word16Rep)
        (PrimRep
Int32Rep) -> (PrimOp
Int32ToWord32Op, PrimRep
Word32Rep)
        (PrimRep
Int64Rep) -> (PrimOp
Int64ToWord64Op, PrimRep
Word64Rep)
        PrimRep
_ -> String -> SDoc -> (PrimOp, PrimRep)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Rep not a wordRep" (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
rep)

-- Casts between any size int to any other size of int
sizedIntToSizedInt :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]
sizedIntToSizedInt :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedIntToSizedInt PrimRep
r1 PrimRep
r2
    | PrimRep
r1 PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
r2 = []
-- Cast to Int#
sizedIntToSizedInt PrimRep
r PrimRep
IntRep = [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intToMachineInt PrimRep
r,Type
intPrimTy)]
-- Cast from Int#
sizedIntToSizedInt PrimRep
IntRep PrimRep
r = [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intFromMachineInt PrimRep
r,PrimRep -> Type
primRepToType PrimRep
r)]
-- Sized to differently sized must go over machine word.
sizedIntToSizedInt PrimRep
r1 PrimRep
r2 = (HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intToMachineInt PrimRep
r1,Type
intPrimTy) (PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
: [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
intFromMachineInt PrimRep
r2,PrimRep -> Type
primRepToType PrimRep
r2)]

-- Casts between any size Word to any other size of Word
sizedWordToSizedWord :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]
sizedWordToSizedWord :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp, Type)]
sizedWordToSizedWord PrimRep
r1 PrimRep
r2
    | PrimRep
r1 PrimRep -> PrimRep -> Bool
forall a. Eq a => a -> a -> Bool
== PrimRep
r2 = []
-- Cast to Word#
sizedWordToSizedWord PrimRep
r PrimRep
WordRep = [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
wordToMachineWord PrimRep
r,Type
wordPrimTy)]
-- Cast from Word#
sizedWordToSizedWord PrimRep
WordRep PrimRep
r = [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
wordFromMachineWord PrimRep
r, PrimRep -> Type
primRepToType PrimRep
r)]
-- Conversion between different non-machine sizes must go via machine word.
sizedWordToSizedWord PrimRep
r1 PrimRep
r2 = (HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
wordToMachineWord PrimRep
r1,Type
wordPrimTy) (PrimOp, Type) -> [(PrimOp, Type)] -> [(PrimOp, Type)]
forall a. a -> [a] -> [a]
: [(HasDebugCallStack => PrimRep -> PrimOp
PrimRep -> PrimOp
wordFromMachineWord PrimRep
r2, PrimRep -> Type
primRepToType PrimRep
r2)]


-- Prefer the definitions above this line if possible
----------------------


-- Int*# to Int#
{-# INLINE intToMachineInt #-}
intToMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intToMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intToMachineInt PrimRep
r =
    Bool -> SDoc -> PrimOp -> PrimOp
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (PrimRep -> Bool
primRepIsInt PrimRep
r) (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r) (PrimOp -> PrimOp) -> PrimOp -> PrimOp
forall a b. (a -> b) -> a -> b
$
    case PrimRep
r of
        (PrimRep
Int8Rep) -> PrimOp
Int8ToIntOp
        (PrimRep
Int16Rep) -> PrimOp
Int16ToIntOp
        (PrimRep
Int32Rep) -> PrimOp
Int32ToIntOp
        (PrimRep
Int64Rep) -> PrimOp
Int64ToIntOp
        PrimRep
_ -> String -> SDoc -> PrimOp
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Source rep not int" (SDoc -> PrimOp) -> SDoc -> PrimOp
forall a b. (a -> b) -> a -> b
$ PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r

-- Int# to Int*#
{-# INLINE intFromMachineInt #-}
intFromMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intFromMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intFromMachineInt PrimRep
r =
    Bool -> SDoc -> PrimOp -> PrimOp
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (PrimRep -> Bool
primRepIsInt PrimRep
r) (PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r) (PrimOp -> PrimOp) -> PrimOp -> PrimOp
forall a b. (a -> b) -> a -> b
$
    case PrimRep
r of
        PrimRep
Int8Rep -> PrimOp
IntToInt8Op
        PrimRep
Int16Rep -> PrimOp
IntToInt16Op
        PrimRep
Int32Rep -> PrimOp
IntToInt32Op
        PrimRep
Int64Rep -> PrimOp
IntToInt64Op
        PrimRep
_ -> String -> SDoc -> PrimOp
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Dest rep not sized int" (SDoc -> PrimOp) -> SDoc -> PrimOp
forall a b. (a -> b) -> a -> b
$ PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r

-- Word# to Word*#
{-# INLINE wordFromMachineWord #-}
wordFromMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordFromMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordFromMachineWord PrimRep
r =
    Bool -> PrimOp -> PrimOp
forall a. HasCallStack => Bool -> a -> a
assert (PrimRep -> Bool
primRepIsWord PrimRep
r) (PrimOp -> PrimOp) -> PrimOp -> PrimOp
forall a b. (a -> b) -> a -> b
$
    case PrimRep
r of
        PrimRep
Word8Rep -> PrimOp
WordToWord8Op
        PrimRep
Word16Rep -> PrimOp
WordToWord16Op
        PrimRep
Word32Rep -> PrimOp
WordToWord32Op
        PrimRep
Word64Rep -> PrimOp
WordToWord64Op
        PrimRep
_ -> String -> SDoc -> PrimOp
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Dest rep not sized word" (SDoc -> PrimOp) -> SDoc -> PrimOp
forall a b. (a -> b) -> a -> b
$ PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r

-- Word*# to Word#
{-# INLINE wordToMachineWord #-}
wordToMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordToMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordToMachineWord PrimRep
r =
    Bool -> SDoc -> PrimOp -> PrimOp
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (PrimRep -> Bool
primRepIsWord PrimRep
r) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Not a word rep:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r) (PrimOp -> PrimOp) -> PrimOp -> PrimOp
forall a b. (a -> b) -> a -> b
$
    case PrimRep
r of
        PrimRep
Word8Rep -> PrimOp
Word8ToWordOp
        PrimRep
Word16Rep -> PrimOp
Word16ToWordOp
        PrimRep
Word32Rep -> PrimOp
Word32ToWordOp
        PrimRep
Word64Rep -> PrimOp
Word64ToWordOp
        PrimRep
_ -> String -> SDoc -> PrimOp
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Dest rep not sized word" (SDoc -> PrimOp) -> SDoc -> PrimOp
forall a b. (a -> b) -> a -> b
$ PrimRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimRep
r