module GHC.Builtin.PrimOps.Casts
( getCasts )
where
import GHC.Prelude
import GHC.Core.TyCon
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Types.RepType
import GHC.Core.Type
import GHC.Builtin.Types.Prim
import GHC.Builtin.PrimOps
import GHC.Plugins (HasDebugCallStack)
getCasts :: PrimRep -> PrimRep -> [(PrimOp,Type)]
getCasts from_rep to_rep
|
to_rep == from_rep
= []
| to_rep == FloatRep =
assertPpr (from_rep == DoubleRep) (ppr from_rep <+> ppr to_rep) $
[(DoubleToFloatOp,floatPrimTy)]
| to_rep == DoubleRep =
assertPpr (from_rep == FloatRep) (ppr from_rep <+> ppr to_rep) $
[(FloatToDoubleOp,doublePrimTy)]
| to_rep == AddrRep = wordOrIntToAddrRep from_rep
| from_rep == AddrRep = addrToWordOrIntRep to_rep
| primRepIsInt from_rep
, primRepIsInt to_rep
= sizedIntToSizedInt from_rep to_rep
| primRepIsWord from_rep
, primRepIsWord to_rep
= sizedWordToSizedWord from_rep to_rep
| primRepIsWord from_rep
, primRepIsInt to_rep
= let (op1,r1) = wordToIntRep from_rep
in (op1,primRepToType r1):sizedIntToSizedInt r1 to_rep
| primRepIsInt from_rep
, primRepIsWord to_rep
= let (op1,r1) = intToWordRep from_rep
in (op1,primRepToType r1):sizedWordToSizedWord r1 to_rep
| otherwise = pprPanic "getCasts:Unexpect rep combination"
(ppr (from_rep,to_rep))
wordOrIntToAddrRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]
wordOrIntToAddrRep AddrRep = []
wordOrIntToAddrRep IntRep = [(IntToAddrOp, addrPrimTy)]
wordOrIntToAddrRep WordRep = [(WordToIntOp,intPrimTy), (IntToAddrOp,addrPrimTy)]
wordOrIntToAddrRep r
| primRepIsInt r = (intToMachineInt r,intPrimTy):[(IntToAddrOp,addrPrimTy)]
| primRepIsWord r =
let (op1,r1) = wordToIntRep r
in (op1, primRepToType r1):[(intToMachineInt r1,intPrimTy), (IntToAddrOp,addrPrimTy)]
| otherwise = pprPanic "Rep not word or int rep" (ppr r)
addrToWordOrIntRep :: HasDebugCallStack => PrimRep -> [(PrimOp,Type)]
addrToWordOrIntRep IntRep = [(AddrToIntOp, intPrimTy)]
addrToWordOrIntRep WordRep = [(AddrToIntOp,intPrimTy), (IntToWordOp,wordPrimTy)]
addrToWordOrIntRep r
| primRepIsWord r = (AddrToIntOp,intPrimTy) : (IntToWordOp,wordPrimTy) : sizedWordToSizedWord WordRep r
| primRepIsInt r = (AddrToIntOp,intPrimTy) : sizedIntToSizedInt IntRep r
| otherwise = pprPanic "Target rep not word or int rep" (ppr r)
wordToIntRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)
wordToIntRep rep
= case rep of
(WordRep) -> (WordToIntOp, IntRep)
(Word8Rep) -> (Word8ToInt8Op, Int8Rep)
(Word16Rep) -> (Word16ToInt16Op, Int16Rep)
(Word32Rep) -> (Word32ToInt32Op, Int32Rep)
(Word64Rep) -> (Word64ToInt64Op, Int64Rep)
_ -> pprPanic "Rep not a wordRep" (ppr rep)
intToWordRep :: HasDebugCallStack => PrimRep -> (PrimOp,PrimRep)
intToWordRep rep
= case rep of
(IntRep) -> (IntToWordOp, WordRep)
(Int8Rep) -> (Int8ToWord8Op, Word8Rep)
(Int16Rep) -> (Int16ToWord16Op, Word16Rep)
(Int32Rep) -> (Int32ToWord32Op, Word32Rep)
(Int64Rep) -> (Int64ToWord64Op, Word64Rep)
_ -> pprPanic "Rep not a wordRep" (ppr rep)
sizedIntToSizedInt :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]
sizedIntToSizedInt r1 r2
| r1 == r2 = []
sizedIntToSizedInt r IntRep = [(intToMachineInt r,intPrimTy)]
sizedIntToSizedInt IntRep r = [(intFromMachineInt r,primRepToType r)]
sizedIntToSizedInt r1 r2 = (intToMachineInt r1,intPrimTy) : [(intFromMachineInt r2,primRepToType r2)]
sizedWordToSizedWord :: HasDebugCallStack => PrimRep -> PrimRep -> [(PrimOp,Type)]
sizedWordToSizedWord r1 r2
| r1 == r2 = []
sizedWordToSizedWord r WordRep = [(wordToMachineWord r,wordPrimTy)]
sizedWordToSizedWord WordRep r = [(wordFromMachineWord r, primRepToType r)]
sizedWordToSizedWord r1 r2 = (wordToMachineWord r1,wordPrimTy) : [(wordFromMachineWord r2, primRepToType r2)]
intToMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intToMachineInt r =
assertPpr (primRepIsInt r) (ppr r) $
case r of
(Int8Rep) -> Int8ToIntOp
(Int16Rep) -> Int16ToIntOp
(Int32Rep) -> Int32ToIntOp
(Int64Rep) -> Int64ToIntOp
_ -> pprPanic "Source rep not int" $ ppr r
intFromMachineInt :: HasDebugCallStack => PrimRep -> PrimOp
intFromMachineInt r =
assertPpr (primRepIsInt r) (ppr r) $
case r of
Int8Rep -> IntToInt8Op
Int16Rep -> IntToInt16Op
Int32Rep -> IntToInt32Op
Int64Rep -> IntToInt64Op
_ -> pprPanic "Dest rep not sized int" $ ppr r
wordFromMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordFromMachineWord r =
assert (primRepIsWord r) $
case r of
Word8Rep -> WordToWord8Op
Word16Rep -> WordToWord16Op
Word32Rep -> WordToWord32Op
Word64Rep -> WordToWord64Op
_ -> pprPanic "Dest rep not sized word" $ ppr r
wordToMachineWord :: HasDebugCallStack => PrimRep -> PrimOp
wordToMachineWord r =
assertPpr (primRepIsWord r) (text "Not a word rep:" <> ppr r) $
case r of
Word8Rep -> Word8ToWordOp
Word16Rep -> Word16ToWordOp
Word32Rep -> Word32ToWordOp
Word64Rep -> Word64ToWordOp
_ -> pprPanic "Dest rep not sized word" $ ppr r