[Git][ghc/ghc][wip/representation-polymorphic-flip] 4 commits: StgToCmm: refactor opTranslate and friends
Bodigrim (@Bodigrim)
gitlab at gitlab.haskell.org
Fri Jun 7 20:56:09 UTC 2024
Bodigrim pushed to branch wip/representation-polymorphic-flip at Glasgow Haskell Compiler / GHC
Commits:
990fed60 by Sylvain Henry at 2024-06-07T14:45:23-04:00
StgToCmm: refactor opTranslate and friends
- Change arguments order to avoid `\args -> ...` lambdas
- Fix documentation
- Rename StgToCmm options ("big" doesn't mean anything)
- - - - -
1afad514 by Sylvain Henry at 2024-06-07T14:45:23-04:00
NCG x86: remove dead code (#5444)
Since 6755d833af8c21bbad6585144b10e20ac4a0a1ab this code is dead.
- - - - -
595c0894 by Cheng Shao at 2024-06-07T14:45:58-04:00
testsuite: skip objc-hi/objcxx-hi when cross compiling
objc-hi/objcxx-hi should be skipped when cross compiling. The existing
opsys('darwin') predicate only asserts the host system is darwin but
tells us nothing about the target, hence the oversight.
- - - - -
edbec6d4 by Andrew Lelechenko at 2024-06-07T22:55:44+02:00
Make flip representation polymorphic, similar to ($) and (&)
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/245
- - - - -
15 changed files:
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/Prim.hs
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- testsuite/tests/driver/objc/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr
- testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
Changes:
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -94,12 +94,6 @@ is32BitPlatform = do
platform <- getPlatform
return $ target32Bit platform
-expect32BitPlatform :: SDoc -> NatM ()
-expect32BitPlatform doc = do
- is32Bit <- is32BitPlatform
- when (not is32Bit) $
- pprPanic "Expecting 32-bit platform" doc
-
sse2Enabled :: NatM Bool
sse2Enabled = do
config <- getConfig
@@ -2475,35 +2469,10 @@ genSimplePrim bid MO_F64_Acosh [dst] [src] = genLibCCall bid
genSimplePrim bid MO_F64_Atanh [dst] [src] = genLibCCall bid (fsLit "atanh") [dst] [src]
genSimplePrim bid MO_SuspendThread [tok] [rs,i] = genRTSCCall bid (fsLit "suspendThread") [tok] [rs,i]
genSimplePrim bid MO_ResumeThread [rs] [tok] = genRTSCCall bid (fsLit "resumeThread") [rs] [tok]
-genSimplePrim _ MO_I64_ToI [dst] [src] = genInt64ToInt dst src
-genSimplePrim _ MO_I64_FromI [dst] [src] = genIntToInt64 dst src
-genSimplePrim _ MO_W64_ToW [dst] [src] = genWord64ToWord dst src
-genSimplePrim _ MO_W64_FromW [dst] [src] = genWordToWord64 dst src
-genSimplePrim _ MO_x64_Neg [dst] [src] = genNeg64 dst src
-genSimplePrim _ MO_x64_Add [dst] [x,y] = genAdd64 dst x y
-genSimplePrim _ MO_x64_Sub [dst] [x,y] = genSub64 dst x y
-genSimplePrim bid MO_x64_Mul [dst] [x,y] = genPrimCCall bid (fsLit "hs_mul64") [dst] [x,y]
genSimplePrim bid MO_I64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotInt64") [dst] [x,y]
genSimplePrim bid MO_I64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remInt64") [dst] [x,y]
genSimplePrim bid MO_W64_Quot [dst] [x,y] = genPrimCCall bid (fsLit "hs_quotWord64") [dst] [x,y]
genSimplePrim bid MO_W64_Rem [dst] [x,y] = genPrimCCall bid (fsLit "hs_remWord64") [dst] [x,y]
-genSimplePrim _ MO_x64_And [dst] [x,y] = genAnd64 dst x y
-genSimplePrim _ MO_x64_Or [dst] [x,y] = genOr64 dst x y
-genSimplePrim _ MO_x64_Xor [dst] [x,y] = genXor64 dst x y
-genSimplePrim _ MO_x64_Not [dst] [src] = genNot64 dst src
-genSimplePrim bid MO_x64_Shl [dst] [x,n] = genPrimCCall bid (fsLit "hs_uncheckedShiftL64") [dst] [x,n]
-genSimplePrim bid MO_I64_Shr [dst] [x,n] = genPrimCCall bid (fsLit "hs_uncheckedIShiftRA64") [dst] [x,n]
-genSimplePrim bid MO_W64_Shr [dst] [x,n] = genPrimCCall bid (fsLit "hs_uncheckedShiftRL64") [dst] [x,n]
-genSimplePrim _ MO_x64_Eq [dst] [x,y] = genEq64 dst x y
-genSimplePrim _ MO_x64_Ne [dst] [x,y] = genNe64 dst x y
-genSimplePrim _ MO_I64_Ge [dst] [x,y] = genGeInt64 dst x y
-genSimplePrim _ MO_I64_Gt [dst] [x,y] = genGtInt64 dst x y
-genSimplePrim _ MO_I64_Le [dst] [x,y] = genLeInt64 dst x y
-genSimplePrim _ MO_I64_Lt [dst] [x,y] = genLtInt64 dst x y
-genSimplePrim _ MO_W64_Ge [dst] [x,y] = genGeWord64 dst x y
-genSimplePrim _ MO_W64_Gt [dst] [x,y] = genGtWord64 dst x y
-genSimplePrim _ MO_W64_Le [dst] [x,y] = genLeWord64 dst x y
-genSimplePrim _ MO_W64_Lt [dst] [x,y] = genLtWord64 dst x y
genSimplePrim _ op dst args = do
platform <- ncgPlatform <$> getConfig
pprPanic "genSimplePrim: unhandled primop" (ppr (pprCallishMachOp op, dst, fmap (pdoc platform) args))
@@ -4462,231 +4431,3 @@ genQuotRem width signed res_q res_r m_arg_x_high arg_x_low arg_y = do
toOL [instr format y_reg,
MOV format (OpReg rax) (OpReg reg_q),
MOV format (OpReg rdx) (OpReg reg_r)]
-
-
-----------------------------------------------------------------------------
--- The following functions implement certain 64-bit MachOps inline for 32-bit
--- architectures. On 64-bit architectures, those MachOps aren't supported and
--- calling these functions for a 64-bit target platform is considered an error
--- (hence the use of `expect32BitPlatform`).
---
--- On 64-bit platforms, generic MachOps should be used instead of these 64-bit
--- specific ones (e.g. use MO_Add instead of MO_x64_Add). This MachOp selection
--- is done by StgToCmm.
-
-genInt64ToInt :: LocalReg -> CmmExpr -> NatM InstrBlock
-genInt64ToInt dst src = do
- expect32BitPlatform (text "genInt64ToInt")
- RegCode64 code _src_hi src_lo <- iselExpr64 src
- let dst_r = getLocalRegReg dst
- pure $ code `snocOL` MOV II32 (OpReg src_lo) (OpReg dst_r)
-
-genWord64ToWord :: LocalReg -> CmmExpr -> NatM InstrBlock
-genWord64ToWord dst src = do
- expect32BitPlatform (text "genWord64ToWord")
- RegCode64 code _src_hi src_lo <- iselExpr64 src
- let dst_r = getLocalRegReg dst
- pure $ code `snocOL` MOV II32 (OpReg src_lo) (OpReg dst_r)
-
-genIntToInt64 :: LocalReg -> CmmExpr -> NatM InstrBlock
-genIntToInt64 dst src = do
- expect32BitPlatform (text "genIntToInt64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- src_code <- getAnyReg src
- pure $ src_code rax `appOL` toOL
- [ CLTD II32 -- sign extend EAX in EDX:EAX
- , MOV II32 (OpReg rax) (OpReg dst_lo)
- , MOV II32 (OpReg rdx) (OpReg dst_hi)
- ]
-
-genWordToWord64 :: LocalReg -> CmmExpr -> NatM InstrBlock
-genWordToWord64 dst src = do
- expect32BitPlatform (text "genWordToWord64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- src_code <- getAnyReg src
- pure $ src_code dst_lo
- `snocOL` XOR II32 (OpReg dst_hi) (OpReg dst_hi)
-
-genNeg64 :: LocalReg -> CmmExpr -> NatM InstrBlock
-genNeg64 dst src = do
- expect32BitPlatform (text "genNeg64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 code src_hi src_lo <- iselExpr64 src
- pure $ code `appOL` toOL
- [ MOV II32 (OpReg src_lo) (OpReg dst_lo)
- , MOV II32 (OpReg src_hi) (OpReg dst_hi)
- , NEGI II32 (OpReg dst_lo)
- , ADC II32 (OpImm (ImmInt 0)) (OpReg dst_hi)
- , NEGI II32 (OpReg dst_hi)
- ]
-
-genAdd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genAdd64 dst x y = do
- expect32BitPlatform (text "genAdd64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg dst_lo)
- , MOV II32 (OpReg x_hi) (OpReg dst_hi)
- , ADD II32 (OpReg y_lo) (OpReg dst_lo)
- , ADC II32 (OpReg y_hi) (OpReg dst_hi)
- ]
-
-genSub64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genSub64 dst x y = do
- expect32BitPlatform (text "genSub64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg dst_lo)
- , MOV II32 (OpReg x_hi) (OpReg dst_hi)
- , SUB II32 (OpReg y_lo) (OpReg dst_lo)
- , SBB II32 (OpReg y_hi) (OpReg dst_hi)
- ]
-
-genAnd64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genAnd64 dst x y = do
- expect32BitPlatform (text "genAnd64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg dst_lo)
- , MOV II32 (OpReg x_hi) (OpReg dst_hi)
- , AND II32 (OpReg y_lo) (OpReg dst_lo)
- , AND II32 (OpReg y_hi) (OpReg dst_hi)
- ]
-
-genOr64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genOr64 dst x y = do
- expect32BitPlatform (text "genOr64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg dst_lo)
- , MOV II32 (OpReg x_hi) (OpReg dst_hi)
- , OR II32 (OpReg y_lo) (OpReg dst_lo)
- , OR II32 (OpReg y_hi) (OpReg dst_hi)
- ]
-
-genXor64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genXor64 dst x y = do
- expect32BitPlatform (text "genXor64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg dst_lo)
- , MOV II32 (OpReg x_hi) (OpReg dst_hi)
- , XOR II32 (OpReg y_lo) (OpReg dst_lo)
- , XOR II32 (OpReg y_hi) (OpReg dst_hi)
- ]
-
-genNot64 :: LocalReg -> CmmExpr -> NatM InstrBlock
-genNot64 dst src = do
- expect32BitPlatform (text "genNot64")
- let Reg64 dst_hi dst_lo = localReg64 dst
- RegCode64 src_code src_hi src_lo <- iselExpr64 src
- pure $ src_code `appOL` toOL
- [ MOV II32 (OpReg src_lo) (OpReg dst_lo)
- , MOV II32 (OpReg src_hi) (OpReg dst_hi)
- , NOT II32 (OpReg dst_lo)
- , NOT II32 (OpReg dst_hi)
- ]
-
-genEq64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genEq64 dst x y = do
- expect32BitPlatform (text "genEq64")
- let dst_r = getLocalRegReg dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- Reg64 tmp_hi tmp_lo <- getNewReg64
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg tmp_lo)
- , MOV II32 (OpReg x_hi) (OpReg tmp_hi)
- , XOR II32 (OpReg y_lo) (OpReg tmp_lo)
- , XOR II32 (OpReg y_hi) (OpReg tmp_hi)
- , OR II32 (OpReg tmp_lo) (OpReg tmp_hi)
- , SETCC EQQ (OpReg dst_r)
- , MOVZxL II8 (OpReg dst_r) (OpReg dst_r)
- ]
-
-genNe64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genNe64 dst x y = do
- expect32BitPlatform (text "genNe64")
- let dst_r = getLocalRegReg dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- Reg64 tmp_hi tmp_lo <- getNewReg64
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_lo) (OpReg tmp_lo)
- , MOV II32 (OpReg x_hi) (OpReg tmp_hi)
- , XOR II32 (OpReg y_lo) (OpReg tmp_lo)
- , XOR II32 (OpReg y_hi) (OpReg tmp_hi)
- , OR II32 (OpReg tmp_lo) (OpReg tmp_hi)
- , SETCC NE (OpReg dst_r)
- , MOVZxL II8 (OpReg dst_r) (OpReg dst_r)
- ]
-
-genGtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genGtWord64 dst x y = do
- expect32BitPlatform (text "genGtWord64")
- genPred64 LU dst y x
-
-genLtWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genLtWord64 dst x y = do
- expect32BitPlatform (text "genLtWord64")
- genPred64 LU dst x y
-
-genGeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genGeWord64 dst x y = do
- expect32BitPlatform (text "genGeWord64")
- genPred64 GEU dst x y
-
-genLeWord64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genLeWord64 dst x y = do
- expect32BitPlatform (text "genLeWord64")
- genPred64 GEU dst y x
-
-genGtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genGtInt64 dst x y = do
- expect32BitPlatform (text "genGtInt64")
- genPred64 LTT dst y x
-
-genLtInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genLtInt64 dst x y = do
- expect32BitPlatform (text "genLtInt64")
- genPred64 LTT dst x y
-
-genGeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genGeInt64 dst x y = do
- expect32BitPlatform (text "genGeInt64")
- genPred64 GE dst x y
-
-genLeInt64 :: LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genLeInt64 dst x y = do
- expect32BitPlatform (text "genLeInt64")
- genPred64 GE dst y x
-
-genPred64 :: Cond -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
-genPred64 cond dst x y = do
- -- we can only rely on CF/SF/OF flags!
- -- Not on ZF, which doesn't take into account the lower parts.
- massert (cond `elem` [LU,GEU,LTT,GE])
-
- let dst_r = getLocalRegReg dst
- RegCode64 x_code x_hi x_lo <- iselExpr64 x
- RegCode64 y_code y_hi y_lo <- iselExpr64 y
- -- Basically we perform a subtraction with borrow.
- -- As we don't need to result, we can use CMP instead of SUB for the low part
- -- (it sets the borrow flag just like SUB does)
- pure $ x_code `appOL` y_code `appOL` toOL
- [ MOV II32 (OpReg x_hi) (OpReg dst_r)
- , CMP II32 (OpReg y_lo) (OpReg x_lo)
- , SBB II32 (OpReg y_hi) (OpReg dst_r)
- , SETCC cond (OpReg dst_r)
- , MOVZxL II8 (OpReg dst_r) (OpReg dst_r)
- ]
=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -53,9 +53,12 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
, stgToCmmExtDynRefs = gopt Opt_ExternalDynamicRefs dflags
, stgToCmmDoBoundsCheck = gopt Opt_DoBoundsChecking dflags
, stgToCmmDoTagCheck = gopt Opt_DoTagInferenceChecks dflags
- -- backend flags
- , stgToCmmAllowBigArith = not ncg || platformArch platform == ArchWasm32 || platformArch platform == ArchX86
- , stgToCmmAllowBigQuot = not ncg || platformArch platform == ArchWasm32
+
+ -- backend flags:
+
+ -- LLVM, C, and some 32-bit NCG backends can also handle some 64-bit primops
+ , stgToCmmAllowArith64 = w64 || not ncg || platformArch platform == ArchWasm32 || platformArch platform == ArchX86
+ , stgToCmmAllowQuot64 = w64 || not ncg || platformArch platform == ArchWasm32
, stgToCmmAllowQuotRemInstr = ncg && (x86ish || ppc)
, stgToCmmAllowQuotRem2 = (ncg && (x86ish || ppc)) || llvm
, stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm
@@ -90,6 +93,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
} where profile = targetProfile dflags
platform = profilePlatform profile
bk_end = backend dflags
+ w64 = platformWordSize platform == PW8
b_blob = if not ncg then Nothing else binBlobThreshold dflags
(ncg, llvm) = case backendPrimitiveImplementation bk_end of
GenericPrimitives -> (False, False)
=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -64,8 +64,8 @@ data StgToCmmConfig = StgToCmmConfig
-- or not
, stgToCmmDoTagCheck :: !Bool -- ^ Verify tag inference predictions.
------------------------------ Backend Flags ----------------------------------
- , stgToCmmAllowBigArith :: !Bool -- ^ Allowed to emit larger than native size arithmetic (only LLVM and C backends)
- , stgToCmmAllowBigQuot :: !Bool -- ^ Allowed to emit larger than native size division operations
+ , stgToCmmAllowArith64 :: !Bool -- ^ Allowed to emit 64-bit arithmetic operations
+ , stgToCmmAllowQuot64 :: !Bool -- ^ Allowed to emit 64-bit division operations
, stgToCmmAllowQuotRemInstr :: !Bool -- ^ Allowed to generate QuotRem instructions
, stgToCmmAllowQuotRem2 :: !Bool -- ^ Allowed to generate QuotRem
, stgToCmmAllowExtendedAddSubInstrs :: !Bool -- ^ Allowed to generate AddWordC, SubWordC, Add2, etc.
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -334,7 +334,7 @@ emitPrimOp cfg primop =
StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))
- EqStablePtrOp -> \args -> opTranslate args (mo_wordEq platform)
+ EqStablePtrOp -> opTranslate (mo_wordEq platform)
ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] ->
emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq platform) [arg1,arg2])
@@ -1180,315 +1180,323 @@ emitPrimOp cfg primop =
Narrow16WordOp -> \args -> opNarrow args (MO_UU_Conv, W16)
Narrow32WordOp -> \args -> opNarrow args (MO_UU_Conv, W32)
- DoublePowerOp -> \args -> opCallish args MO_F64_Pwr
- DoubleSinOp -> \args -> opCallish args MO_F64_Sin
- DoubleCosOp -> \args -> opCallish args MO_F64_Cos
- DoubleTanOp -> \args -> opCallish args MO_F64_Tan
- DoubleSinhOp -> \args -> opCallish args MO_F64_Sinh
- DoubleCoshOp -> \args -> opCallish args MO_F64_Cosh
- DoubleTanhOp -> \args -> opCallish args MO_F64_Tanh
- DoubleAsinOp -> \args -> opCallish args MO_F64_Asin
- DoubleAcosOp -> \args -> opCallish args MO_F64_Acos
- DoubleAtanOp -> \args -> opCallish args MO_F64_Atan
- DoubleAsinhOp -> \args -> opCallish args MO_F64_Asinh
- DoubleAcoshOp -> \args -> opCallish args MO_F64_Acosh
- DoubleAtanhOp -> \args -> opCallish args MO_F64_Atanh
- DoubleLogOp -> \args -> opCallish args MO_F64_Log
- DoubleLog1POp -> \args -> opCallish args MO_F64_Log1P
- DoubleExpOp -> \args -> opCallish args MO_F64_Exp
- DoubleExpM1Op -> \args -> opCallish args MO_F64_ExpM1
- DoubleSqrtOp -> \args -> opCallish args MO_F64_Sqrt
- DoubleFabsOp -> \args -> opCallish args MO_F64_Fabs
-
- FloatPowerOp -> \args -> opCallish args MO_F32_Pwr
- FloatSinOp -> \args -> opCallish args MO_F32_Sin
- FloatCosOp -> \args -> opCallish args MO_F32_Cos
- FloatTanOp -> \args -> opCallish args MO_F32_Tan
- FloatSinhOp -> \args -> opCallish args MO_F32_Sinh
- FloatCoshOp -> \args -> opCallish args MO_F32_Cosh
- FloatTanhOp -> \args -> opCallish args MO_F32_Tanh
- FloatAsinOp -> \args -> opCallish args MO_F32_Asin
- FloatAcosOp -> \args -> opCallish args MO_F32_Acos
- FloatAtanOp -> \args -> opCallish args MO_F32_Atan
- FloatAsinhOp -> \args -> opCallish args MO_F32_Asinh
- FloatAcoshOp -> \args -> opCallish args MO_F32_Acosh
- FloatAtanhOp -> \args -> opCallish args MO_F32_Atanh
- FloatLogOp -> \args -> opCallish args MO_F32_Log
- FloatLog1POp -> \args -> opCallish args MO_F32_Log1P
- FloatExpOp -> \args -> opCallish args MO_F32_Exp
- FloatExpM1Op -> \args -> opCallish args MO_F32_ExpM1
- FloatSqrtOp -> \args -> opCallish args MO_F32_Sqrt
- FloatFabsOp -> \args -> opCallish args MO_F32_Fabs
+ DoublePowerOp -> opCallish MO_F64_Pwr
+ DoubleSinOp -> opCallish MO_F64_Sin
+ DoubleCosOp -> opCallish MO_F64_Cos
+ DoubleTanOp -> opCallish MO_F64_Tan
+ DoubleSinhOp -> opCallish MO_F64_Sinh
+ DoubleCoshOp -> opCallish MO_F64_Cosh
+ DoubleTanhOp -> opCallish MO_F64_Tanh
+ DoubleAsinOp -> opCallish MO_F64_Asin
+ DoubleAcosOp -> opCallish MO_F64_Acos
+ DoubleAtanOp -> opCallish MO_F64_Atan
+ DoubleAsinhOp -> opCallish MO_F64_Asinh
+ DoubleAcoshOp -> opCallish MO_F64_Acosh
+ DoubleAtanhOp -> opCallish MO_F64_Atanh
+ DoubleLogOp -> opCallish MO_F64_Log
+ DoubleLog1POp -> opCallish MO_F64_Log1P
+ DoubleExpOp -> opCallish MO_F64_Exp
+ DoubleExpM1Op -> opCallish MO_F64_ExpM1
+ DoubleSqrtOp -> opCallish MO_F64_Sqrt
+ DoubleFabsOp -> opCallish MO_F64_Fabs
+
+ FloatPowerOp -> opCallish MO_F32_Pwr
+ FloatSinOp -> opCallish MO_F32_Sin
+ FloatCosOp -> opCallish MO_F32_Cos
+ FloatTanOp -> opCallish MO_F32_Tan
+ FloatSinhOp -> opCallish MO_F32_Sinh
+ FloatCoshOp -> opCallish MO_F32_Cosh
+ FloatTanhOp -> opCallish MO_F32_Tanh
+ FloatAsinOp -> opCallish MO_F32_Asin
+ FloatAcosOp -> opCallish MO_F32_Acos
+ FloatAtanOp -> opCallish MO_F32_Atan
+ FloatAsinhOp -> opCallish MO_F32_Asinh
+ FloatAcoshOp -> opCallish MO_F32_Acosh
+ FloatAtanhOp -> opCallish MO_F32_Atanh
+ FloatLogOp -> opCallish MO_F32_Log
+ FloatLog1POp -> opCallish MO_F32_Log1P
+ FloatExpOp -> opCallish MO_F32_Exp
+ FloatExpM1Op -> opCallish MO_F32_ExpM1
+ FloatSqrtOp -> opCallish MO_F32_Sqrt
+ FloatFabsOp -> opCallish MO_F32_Fabs
-- Native word signless ops
- IntAddOp -> \args -> opTranslate args (mo_wordAdd platform)
- IntSubOp -> \args -> opTranslate args (mo_wordSub platform)
- WordAddOp -> \args -> opTranslate args (mo_wordAdd platform)
- WordSubOp -> \args -> opTranslate args (mo_wordSub platform)
- AddrAddOp -> \args -> opTranslate args (mo_wordAdd platform)
- AddrSubOp -> \args -> opTranslate args (mo_wordSub platform)
-
- IntEqOp -> \args -> opTranslate args (mo_wordEq platform)
- IntNeOp -> \args -> opTranslate args (mo_wordNe platform)
- WordEqOp -> \args -> opTranslate args (mo_wordEq platform)
- WordNeOp -> \args -> opTranslate args (mo_wordNe platform)
- AddrEqOp -> \args -> opTranslate args (mo_wordEq platform)
- AddrNeOp -> \args -> opTranslate args (mo_wordNe platform)
-
- WordAndOp -> \args -> opTranslate args (mo_wordAnd platform)
- WordOrOp -> \args -> opTranslate args (mo_wordOr platform)
- WordXorOp -> \args -> opTranslate args (mo_wordXor platform)
- WordNotOp -> \args -> opTranslate args (mo_wordNot platform)
- WordSllOp -> \args -> opTranslate args (mo_wordShl platform)
- WordSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
-
- AddrRemOp -> \args -> opTranslate args (mo_wordURem platform)
+ IntAddOp -> opTranslate (mo_wordAdd platform)
+ IntSubOp -> opTranslate (mo_wordSub platform)
+ WordAddOp -> opTranslate (mo_wordAdd platform)
+ WordSubOp -> opTranslate (mo_wordSub platform)
+ AddrAddOp -> opTranslate (mo_wordAdd platform)
+ AddrSubOp -> opTranslate (mo_wordSub platform)
+
+ IntEqOp -> opTranslate (mo_wordEq platform)
+ IntNeOp -> opTranslate (mo_wordNe platform)
+ WordEqOp -> opTranslate (mo_wordEq platform)
+ WordNeOp -> opTranslate (mo_wordNe platform)
+ AddrEqOp -> opTranslate (mo_wordEq platform)
+ AddrNeOp -> opTranslate (mo_wordNe platform)
+
+ WordAndOp -> opTranslate (mo_wordAnd platform)
+ WordOrOp -> opTranslate (mo_wordOr platform)
+ WordXorOp -> opTranslate (mo_wordXor platform)
+ WordNotOp -> opTranslate (mo_wordNot platform)
+ WordSllOp -> opTranslate (mo_wordShl platform)
+ WordSrlOp -> opTranslate (mo_wordUShr platform)
+
+ AddrRemOp -> opTranslate (mo_wordURem platform)
-- Native word signed ops
- IntMulOp -> \args -> opTranslate args (mo_wordMul platform)
- IntMulMayOfloOp -> \args -> opTranslate args (MO_S_MulMayOflo (wordWidth platform))
- IntQuotOp -> \args -> opTranslate args (mo_wordSQuot platform)
- IntRemOp -> \args -> opTranslate args (mo_wordSRem platform)
- IntNegOp -> \args -> opTranslate args (mo_wordSNeg platform)
-
- IntGeOp -> \args -> opTranslate args (mo_wordSGe platform)
- IntLeOp -> \args -> opTranslate args (mo_wordSLe platform)
- IntGtOp -> \args -> opTranslate args (mo_wordSGt platform)
- IntLtOp -> \args -> opTranslate args (mo_wordSLt platform)
-
- IntAndOp -> \args -> opTranslate args (mo_wordAnd platform)
- IntOrOp -> \args -> opTranslate args (mo_wordOr platform)
- IntXorOp -> \args -> opTranslate args (mo_wordXor platform)
- IntNotOp -> \args -> opTranslate args (mo_wordNot platform)
- IntSllOp -> \args -> opTranslate args (mo_wordShl platform)
- IntSraOp -> \args -> opTranslate args (mo_wordSShr platform)
- IntSrlOp -> \args -> opTranslate args (mo_wordUShr platform)
+ IntMulOp -> opTranslate (mo_wordMul platform)
+ IntMulMayOfloOp -> opTranslate (MO_S_MulMayOflo (wordWidth platform))
+ IntQuotOp -> opTranslate (mo_wordSQuot platform)
+ IntRemOp -> opTranslate (mo_wordSRem platform)
+ IntNegOp -> opTranslate (mo_wordSNeg platform)
+
+ IntGeOp -> opTranslate (mo_wordSGe platform)
+ IntLeOp -> opTranslate (mo_wordSLe platform)
+ IntGtOp -> opTranslate (mo_wordSGt platform)
+ IntLtOp -> opTranslate (mo_wordSLt platform)
+
+ IntAndOp -> opTranslate (mo_wordAnd platform)
+ IntOrOp -> opTranslate (mo_wordOr platform)
+ IntXorOp -> opTranslate (mo_wordXor platform)
+ IntNotOp -> opTranslate (mo_wordNot platform)
+ IntSllOp -> opTranslate (mo_wordShl platform)
+ IntSraOp -> opTranslate (mo_wordSShr platform)
+ IntSrlOp -> opTranslate (mo_wordUShr platform)
-- Native word unsigned ops
- WordGeOp -> \args -> opTranslate args (mo_wordUGe platform)
- WordLeOp -> \args -> opTranslate args (mo_wordULe platform)
- WordGtOp -> \args -> opTranslate args (mo_wordUGt platform)
- WordLtOp -> \args -> opTranslate args (mo_wordULt platform)
+ WordGeOp -> opTranslate (mo_wordUGe platform)
+ WordLeOp -> opTranslate (mo_wordULe platform)
+ WordGtOp -> opTranslate (mo_wordUGt platform)
+ WordLtOp -> opTranslate (mo_wordULt platform)
- WordMulOp -> \args -> opTranslate args (mo_wordMul platform)
- WordQuotOp -> \args -> opTranslate args (mo_wordUQuot platform)
- WordRemOp -> \args -> opTranslate args (mo_wordURem platform)
+ WordMulOp -> opTranslate (mo_wordMul platform)
+ WordQuotOp -> opTranslate (mo_wordUQuot platform)
+ WordRemOp -> opTranslate (mo_wordURem platform)
- AddrGeOp -> \args -> opTranslate args (mo_wordUGe platform)
- AddrLeOp -> \args -> opTranslate args (mo_wordULe platform)
- AddrGtOp -> \args -> opTranslate args (mo_wordUGt platform)
- AddrLtOp -> \args -> opTranslate args (mo_wordULt platform)
+ AddrGeOp -> opTranslate (mo_wordUGe platform)
+ AddrLeOp -> opTranslate (mo_wordULe platform)
+ AddrGtOp -> opTranslate (mo_wordUGt platform)
+ AddrLtOp -> opTranslate (mo_wordULt platform)
-- Int8# signed ops
- Int8ToIntOp -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform))
- IntToInt8Op -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8)
- Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8)
- Int8AddOp -> \args -> opTranslate args (MO_Add W8)
- Int8SubOp -> \args -> opTranslate args (MO_Sub W8)
- Int8MulOp -> \args -> opTranslate args (MO_Mul W8)
- Int8QuotOp -> \args -> opTranslate args (MO_S_Quot W8)
- Int8RemOp -> \args -> opTranslate args (MO_S_Rem W8)
-
- Int8SllOp -> \args -> opTranslate args (MO_Shl W8)
- Int8SraOp -> \args -> opTranslate args (MO_S_Shr W8)
- Int8SrlOp -> \args -> opTranslate args (MO_U_Shr W8)
-
- Int8EqOp -> \args -> opTranslate args (MO_Eq W8)
- Int8GeOp -> \args -> opTranslate args (MO_S_Ge W8)
- Int8GtOp -> \args -> opTranslate args (MO_S_Gt W8)
- Int8LeOp -> \args -> opTranslate args (MO_S_Le W8)
- Int8LtOp -> \args -> opTranslate args (MO_S_Lt W8)
- Int8NeOp -> \args -> opTranslate args (MO_Ne W8)
+ Int8ToIntOp -> opTranslate (MO_SS_Conv W8 (wordWidth platform))
+ IntToInt8Op -> opTranslate (MO_SS_Conv (wordWidth platform) W8)
+ Int8NegOp -> opTranslate (MO_S_Neg W8)
+ Int8AddOp -> opTranslate (MO_Add W8)
+ Int8SubOp -> opTranslate (MO_Sub W8)
+ Int8MulOp -> opTranslate (MO_Mul W8)
+ Int8QuotOp -> opTranslate (MO_S_Quot W8)
+ Int8RemOp -> opTranslate (MO_S_Rem W8)
+
+ Int8SllOp -> opTranslate (MO_Shl W8)
+ Int8SraOp -> opTranslate (MO_S_Shr W8)
+ Int8SrlOp -> opTranslate (MO_U_Shr W8)
+
+ Int8EqOp -> opTranslate (MO_Eq W8)
+ Int8GeOp -> opTranslate (MO_S_Ge W8)
+ Int8GtOp -> opTranslate (MO_S_Gt W8)
+ Int8LeOp -> opTranslate (MO_S_Le W8)
+ Int8LtOp -> opTranslate (MO_S_Lt W8)
+ Int8NeOp -> opTranslate (MO_Ne W8)
-- Word8# unsigned ops
- Word8ToWordOp -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform))
- WordToWord8Op -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8)
- Word8AddOp -> \args -> opTranslate args (MO_Add W8)
- Word8SubOp -> \args -> opTranslate args (MO_Sub W8)
- Word8MulOp -> \args -> opTranslate args (MO_Mul W8)
- Word8QuotOp -> \args -> opTranslate args (MO_U_Quot W8)
- Word8RemOp -> \args -> opTranslate args (MO_U_Rem W8)
-
- Word8AndOp -> \args -> opTranslate args (MO_And W8)
- Word8OrOp -> \args -> opTranslate args (MO_Or W8)
- Word8XorOp -> \args -> opTranslate args (MO_Xor W8)
- Word8NotOp -> \args -> opTranslate args (MO_Not W8)
- Word8SllOp -> \args -> opTranslate args (MO_Shl W8)
- Word8SrlOp -> \args -> opTranslate args (MO_U_Shr W8)
-
- Word8EqOp -> \args -> opTranslate args (MO_Eq W8)
- Word8GeOp -> \args -> opTranslate args (MO_U_Ge W8)
- Word8GtOp -> \args -> opTranslate args (MO_U_Gt W8)
- Word8LeOp -> \args -> opTranslate args (MO_U_Le W8)
- Word8LtOp -> \args -> opTranslate args (MO_U_Lt W8)
- Word8NeOp -> \args -> opTranslate args (MO_Ne W8)
+ Word8ToWordOp -> opTranslate (MO_UU_Conv W8 (wordWidth platform))
+ WordToWord8Op -> opTranslate (MO_UU_Conv (wordWidth platform) W8)
+ Word8AddOp -> opTranslate (MO_Add W8)
+ Word8SubOp -> opTranslate (MO_Sub W8)
+ Word8MulOp -> opTranslate (MO_Mul W8)
+ Word8QuotOp -> opTranslate (MO_U_Quot W8)
+ Word8RemOp -> opTranslate (MO_U_Rem W8)
+
+ Word8AndOp -> opTranslate (MO_And W8)
+ Word8OrOp -> opTranslate (MO_Or W8)
+ Word8XorOp -> opTranslate (MO_Xor W8)
+ Word8NotOp -> opTranslate (MO_Not W8)
+ Word8SllOp -> opTranslate (MO_Shl W8)
+ Word8SrlOp -> opTranslate (MO_U_Shr W8)
+
+ Word8EqOp -> opTranslate (MO_Eq W8)
+ Word8GeOp -> opTranslate (MO_U_Ge W8)
+ Word8GtOp -> opTranslate (MO_U_Gt W8)
+ Word8LeOp -> opTranslate (MO_U_Le W8)
+ Word8LtOp -> opTranslate (MO_U_Lt W8)
+ Word8NeOp -> opTranslate (MO_Ne W8)
-- Int16# signed ops
- Int16ToIntOp -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform))
- IntToInt16Op -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16)
- Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16)
- Int16AddOp -> \args -> opTranslate args (MO_Add W16)
- Int16SubOp -> \args -> opTranslate args (MO_Sub W16)
- Int16MulOp -> \args -> opTranslate args (MO_Mul W16)
- Int16QuotOp -> \args -> opTranslate args (MO_S_Quot W16)
- Int16RemOp -> \args -> opTranslate args (MO_S_Rem W16)
-
- Int16SllOp -> \args -> opTranslate args (MO_Shl W16)
- Int16SraOp -> \args -> opTranslate args (MO_S_Shr W16)
- Int16SrlOp -> \args -> opTranslate args (MO_U_Shr W16)
-
- Int16EqOp -> \args -> opTranslate args (MO_Eq W16)
- Int16GeOp -> \args -> opTranslate args (MO_S_Ge W16)
- Int16GtOp -> \args -> opTranslate args (MO_S_Gt W16)
- Int16LeOp -> \args -> opTranslate args (MO_S_Le W16)
- Int16LtOp -> \args -> opTranslate args (MO_S_Lt W16)
- Int16NeOp -> \args -> opTranslate args (MO_Ne W16)
+ Int16ToIntOp -> opTranslate (MO_SS_Conv W16 (wordWidth platform))
+ IntToInt16Op -> opTranslate (MO_SS_Conv (wordWidth platform) W16)
+ Int16NegOp -> opTranslate (MO_S_Neg W16)
+ Int16AddOp -> opTranslate (MO_Add W16)
+ Int16SubOp -> opTranslate (MO_Sub W16)
+ Int16MulOp -> opTranslate (MO_Mul W16)
+ Int16QuotOp -> opTranslate (MO_S_Quot W16)
+ Int16RemOp -> opTranslate (MO_S_Rem W16)
+
+ Int16SllOp -> opTranslate (MO_Shl W16)
+ Int16SraOp -> opTranslate (MO_S_Shr W16)
+ Int16SrlOp -> opTranslate (MO_U_Shr W16)
+
+ Int16EqOp -> opTranslate (MO_Eq W16)
+ Int16GeOp -> opTranslate (MO_S_Ge W16)
+ Int16GtOp -> opTranslate (MO_S_Gt W16)
+ Int16LeOp -> opTranslate (MO_S_Le W16)
+ Int16LtOp -> opTranslate (MO_S_Lt W16)
+ Int16NeOp -> opTranslate (MO_Ne W16)
-- Word16# unsigned ops
- Word16ToWordOp -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform))
- WordToWord16Op -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16)
- Word16AddOp -> \args -> opTranslate args (MO_Add W16)
- Word16SubOp -> \args -> opTranslate args (MO_Sub W16)
- Word16MulOp -> \args -> opTranslate args (MO_Mul W16)
- Word16QuotOp -> \args -> opTranslate args (MO_U_Quot W16)
- Word16RemOp -> \args -> opTranslate args (MO_U_Rem W16)
-
- Word16AndOp -> \args -> opTranslate args (MO_And W16)
- Word16OrOp -> \args -> opTranslate args (MO_Or W16)
- Word16XorOp -> \args -> opTranslate args (MO_Xor W16)
- Word16NotOp -> \args -> opTranslate args (MO_Not W16)
- Word16SllOp -> \args -> opTranslate args (MO_Shl W16)
- Word16SrlOp -> \args -> opTranslate args (MO_U_Shr W16)
-
- Word16EqOp -> \args -> opTranslate args (MO_Eq W16)
- Word16GeOp -> \args -> opTranslate args (MO_U_Ge W16)
- Word16GtOp -> \args -> opTranslate args (MO_U_Gt W16)
- Word16LeOp -> \args -> opTranslate args (MO_U_Le W16)
- Word16LtOp -> \args -> opTranslate args (MO_U_Lt W16)
- Word16NeOp -> \args -> opTranslate args (MO_Ne W16)
+ Word16ToWordOp -> opTranslate (MO_UU_Conv W16 (wordWidth platform))
+ WordToWord16Op -> opTranslate (MO_UU_Conv (wordWidth platform) W16)
+ Word16AddOp -> opTranslate (MO_Add W16)
+ Word16SubOp -> opTranslate (MO_Sub W16)
+ Word16MulOp -> opTranslate (MO_Mul W16)
+ Word16QuotOp -> opTranslate (MO_U_Quot W16)
+ Word16RemOp -> opTranslate (MO_U_Rem W16)
+
+ Word16AndOp -> opTranslate (MO_And W16)
+ Word16OrOp -> opTranslate (MO_Or W16)
+ Word16XorOp -> opTranslate (MO_Xor W16)
+ Word16NotOp -> opTranslate (MO_Not W16)
+ Word16SllOp -> opTranslate (MO_Shl W16)
+ Word16SrlOp -> opTranslate (MO_U_Shr W16)
+
+ Word16EqOp -> opTranslate (MO_Eq W16)
+ Word16GeOp -> opTranslate (MO_U_Ge W16)
+ Word16GtOp -> opTranslate (MO_U_Gt W16)
+ Word16LeOp -> opTranslate (MO_U_Le W16)
+ Word16LtOp -> opTranslate (MO_U_Lt W16)
+ Word16NeOp -> opTranslate (MO_Ne W16)
-- Int32# signed ops
- Int32ToIntOp -> \args -> opTranslate args (MO_SS_Conv W32 (wordWidth platform))
- IntToInt32Op -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W32)
- Int32NegOp -> \args -> opTranslate args (MO_S_Neg W32)
- Int32AddOp -> \args -> opTranslate args (MO_Add W32)
- Int32SubOp -> \args -> opTranslate args (MO_Sub W32)
- Int32MulOp -> \args -> opTranslate args (MO_Mul W32)
- Int32QuotOp -> \args -> opTranslate args (MO_S_Quot W32)
- Int32RemOp -> \args -> opTranslate args (MO_S_Rem W32)
-
- Int32SllOp -> \args -> opTranslate args (MO_Shl W32)
- Int32SraOp -> \args -> opTranslate args (MO_S_Shr W32)
- Int32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
-
- Int32EqOp -> \args -> opTranslate args (MO_Eq W32)
- Int32GeOp -> \args -> opTranslate args (MO_S_Ge W32)
- Int32GtOp -> \args -> opTranslate args (MO_S_Gt W32)
- Int32LeOp -> \args -> opTranslate args (MO_S_Le W32)
- Int32LtOp -> \args -> opTranslate args (MO_S_Lt W32)
- Int32NeOp -> \args -> opTranslate args (MO_Ne W32)
+ Int32ToIntOp -> opTranslate (MO_SS_Conv W32 (wordWidth platform))
+ IntToInt32Op -> opTranslate (MO_SS_Conv (wordWidth platform) W32)
+ Int32NegOp -> opTranslate (MO_S_Neg W32)
+ Int32AddOp -> opTranslate (MO_Add W32)
+ Int32SubOp -> opTranslate (MO_Sub W32)
+ Int32MulOp -> opTranslate (MO_Mul W32)
+ Int32QuotOp -> opTranslate (MO_S_Quot W32)
+ Int32RemOp -> opTranslate (MO_S_Rem W32)
+
+ Int32SllOp -> opTranslate (MO_Shl W32)
+ Int32SraOp -> opTranslate (MO_S_Shr W32)
+ Int32SrlOp -> opTranslate (MO_U_Shr W32)
+
+ Int32EqOp -> opTranslate (MO_Eq W32)
+ Int32GeOp -> opTranslate (MO_S_Ge W32)
+ Int32GtOp -> opTranslate (MO_S_Gt W32)
+ Int32LeOp -> opTranslate (MO_S_Le W32)
+ Int32LtOp -> opTranslate (MO_S_Lt W32)
+ Int32NeOp -> opTranslate (MO_Ne W32)
-- Word32# unsigned ops
- Word32ToWordOp -> \args -> opTranslate args (MO_UU_Conv W32 (wordWidth platform))
- WordToWord32Op -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W32)
- Word32AddOp -> \args -> opTranslate args (MO_Add W32)
- Word32SubOp -> \args -> opTranslate args (MO_Sub W32)
- Word32MulOp -> \args -> opTranslate args (MO_Mul W32)
- Word32QuotOp -> \args -> opTranslate args (MO_U_Quot W32)
- Word32RemOp -> \args -> opTranslate args (MO_U_Rem W32)
-
- Word32AndOp -> \args -> opTranslate args (MO_And W32)
- Word32OrOp -> \args -> opTranslate args (MO_Or W32)
- Word32XorOp -> \args -> opTranslate args (MO_Xor W32)
- Word32NotOp -> \args -> opTranslate args (MO_Not W32)
- Word32SllOp -> \args -> opTranslate args (MO_Shl W32)
- Word32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
-
- Word32EqOp -> \args -> opTranslate args (MO_Eq W32)
- Word32GeOp -> \args -> opTranslate args (MO_U_Ge W32)
- Word32GtOp -> \args -> opTranslate args (MO_U_Gt W32)
- Word32LeOp -> \args -> opTranslate args (MO_U_Le W32)
- Word32LtOp -> \args -> opTranslate args (MO_U_Lt W32)
- Word32NeOp -> \args -> opTranslate args (MO_Ne W32)
+ Word32ToWordOp -> opTranslate (MO_UU_Conv W32 (wordWidth platform))
+ WordToWord32Op -> opTranslate (MO_UU_Conv (wordWidth platform) W32)
+ Word32AddOp -> opTranslate (MO_Add W32)
+ Word32SubOp -> opTranslate (MO_Sub W32)
+ Word32MulOp -> opTranslate (MO_Mul W32)
+ Word32QuotOp -> opTranslate (MO_U_Quot W32)
+ Word32RemOp -> opTranslate (MO_U_Rem W32)
+
+ Word32AndOp -> opTranslate (MO_And W32)
+ Word32OrOp -> opTranslate (MO_Or W32)
+ Word32XorOp -> opTranslate (MO_Xor W32)
+ Word32NotOp -> opTranslate (MO_Not W32)
+ Word32SllOp -> opTranslate (MO_Shl W32)
+ Word32SrlOp -> opTranslate (MO_U_Shr W32)
+
+ Word32EqOp -> opTranslate (MO_Eq W32)
+ Word32GeOp -> opTranslate (MO_U_Ge W32)
+ Word32GtOp -> opTranslate (MO_U_Gt W32)
+ Word32LeOp -> opTranslate (MO_U_Le W32)
+ Word32LtOp -> opTranslate (MO_U_Lt W32)
+ Word32NeOp -> opTranslate (MO_Ne W32)
-- Int64# signed ops
- Int64ToIntOp -> \args -> opTranslate64 args (\w -> MO_SS_Conv w (wordWidth platform)) MO_I64_ToI
- IntToInt64Op -> \args -> opTranslate64 args (\w -> MO_SS_Conv (wordWidth platform) w) MO_I64_FromI
- Int64NegOp -> \args -> opTranslate64 args MO_S_Neg MO_x64_Neg
- Int64AddOp -> \args -> opTranslate64 args MO_Add MO_x64_Add
- Int64SubOp -> \args -> opTranslate64 args MO_Sub MO_x64_Sub
- Int64MulOp -> \args -> opTranslate64 args MO_Mul MO_x64_Mul
- Int64QuotOp -> \args -> opTranslate64 args MO_S_Quot MO_I64_Quot
- Int64RemOp -> \args -> opTranslate64 args MO_S_Rem MO_I64_Rem
-
- Int64SllOp -> \args -> opTranslate64 args MO_Shl MO_x64_Shl
- Int64SraOp -> \args -> opTranslate64 args MO_S_Shr MO_I64_Shr
- Int64SrlOp -> \args -> opTranslate64 args MO_U_Shr MO_W64_Shr
-
- Int64EqOp -> \args -> opTranslate64 args MO_Eq MO_x64_Eq
- Int64GeOp -> \args -> opTranslate64 args MO_S_Ge MO_I64_Ge
- Int64GtOp -> \args -> opTranslate64 args MO_S_Gt MO_I64_Gt
- Int64LeOp -> \args -> opTranslate64 args MO_S_Le MO_I64_Le
- Int64LtOp -> \args -> opTranslate64 args MO_S_Lt MO_I64_Lt
- Int64NeOp -> \args -> opTranslate64 args MO_Ne MO_x64_Ne
+ Int64ToIntOp -> opTranslate64 (MO_SS_Conv W64 (wordWidth platform)) MO_I64_ToI
+ IntToInt64Op -> opTranslate64 (MO_SS_Conv (wordWidth platform) W64) MO_I64_FromI
+ Int64NegOp -> opTranslate64 (MO_S_Neg W64) MO_x64_Neg
+ Int64AddOp -> opTranslate64 (MO_Add W64) MO_x64_Add
+ Int64SubOp -> opTranslate64 (MO_Sub W64) MO_x64_Sub
+ Int64MulOp -> opTranslate64 (MO_Mul W64) MO_x64_Mul
+ Int64QuotOp
+ | allowQuot64 -> opTranslate (MO_S_Quot W64)
+ | otherwise -> opCallish MO_I64_Quot
+ Int64RemOp
+ | allowQuot64 -> opTranslate (MO_S_Rem W64)
+ | otherwise -> opCallish MO_I64_Rem
+
+ Int64SllOp -> opTranslate64 (MO_Shl W64) MO_x64_Shl
+ Int64SraOp -> opTranslate64 (MO_S_Shr W64) MO_I64_Shr
+ Int64SrlOp -> opTranslate64 (MO_U_Shr W64) MO_W64_Shr
+
+ Int64EqOp -> opTranslate64 (MO_Eq W64) MO_x64_Eq
+ Int64GeOp -> opTranslate64 (MO_S_Ge W64) MO_I64_Ge
+ Int64GtOp -> opTranslate64 (MO_S_Gt W64) MO_I64_Gt
+ Int64LeOp -> opTranslate64 (MO_S_Le W64) MO_I64_Le
+ Int64LtOp -> opTranslate64 (MO_S_Lt W64) MO_I64_Lt
+ Int64NeOp -> opTranslate64 (MO_Ne W64) MO_x64_Ne
-- Word64# unsigned ops
- Word64ToWordOp -> \args -> opTranslate64 args (\w -> MO_UU_Conv w (wordWidth platform)) MO_W64_ToW
- WordToWord64Op -> \args -> opTranslate64 args (\w -> MO_UU_Conv (wordWidth platform) w) MO_W64_FromW
- Word64AddOp -> \args -> opTranslate64 args MO_Add MO_x64_Add
- Word64SubOp -> \args -> opTranslate64 args MO_Sub MO_x64_Sub
- Word64MulOp -> \args -> opTranslate64 args MO_Mul MO_x64_Mul
- Word64QuotOp -> \args -> opTranslate64 args MO_U_Quot MO_W64_Quot
- Word64RemOp -> \args -> opTranslate64 args MO_U_Rem MO_W64_Rem
-
- Word64AndOp -> \args -> opTranslate64 args MO_And MO_x64_And
- Word64OrOp -> \args -> opTranslate64 args MO_Or MO_x64_Or
- Word64XorOp -> \args -> opTranslate64 args MO_Xor MO_x64_Xor
- Word64NotOp -> \args -> opTranslate64 args MO_Not MO_x64_Not
- Word64SllOp -> \args -> opTranslate64 args MO_Shl MO_x64_Shl
- Word64SrlOp -> \args -> opTranslate64 args MO_U_Shr MO_W64_Shr
-
- Word64EqOp -> \args -> opTranslate64 args MO_Eq MO_x64_Eq
- Word64GeOp -> \args -> opTranslate64 args MO_U_Ge MO_W64_Ge
- Word64GtOp -> \args -> opTranslate64 args MO_U_Gt MO_W64_Gt
- Word64LeOp -> \args -> opTranslate64 args MO_U_Le MO_W64_Le
- Word64LtOp -> \args -> opTranslate64 args MO_U_Lt MO_W64_Lt
- Word64NeOp -> \args -> opTranslate64 args MO_Ne MO_x64_Ne
+ Word64ToWordOp -> opTranslate64 (MO_UU_Conv W64 (wordWidth platform)) MO_W64_ToW
+ WordToWord64Op -> opTranslate64 (MO_UU_Conv (wordWidth platform) W64) MO_W64_FromW
+ Word64AddOp -> opTranslate64 (MO_Add W64) MO_x64_Add
+ Word64SubOp -> opTranslate64 (MO_Sub W64) MO_x64_Sub
+ Word64MulOp -> opTranslate64 (MO_Mul W64) MO_x64_Mul
+ Word64QuotOp
+ | allowQuot64 -> opTranslate (MO_U_Quot W64)
+ | otherwise -> opCallish MO_W64_Quot
+ Word64RemOp
+ | allowQuot64 -> opTranslate (MO_U_Rem W64)
+ | otherwise -> opCallish MO_W64_Rem
+
+ Word64AndOp -> opTranslate64 (MO_And W64) MO_x64_And
+ Word64OrOp -> opTranslate64 (MO_Or W64) MO_x64_Or
+ Word64XorOp -> opTranslate64 (MO_Xor W64) MO_x64_Xor
+ Word64NotOp -> opTranslate64 (MO_Not W64) MO_x64_Not
+ Word64SllOp -> opTranslate64 (MO_Shl W64) MO_x64_Shl
+ Word64SrlOp -> opTranslate64 (MO_U_Shr W64) MO_W64_Shr
+
+ Word64EqOp -> opTranslate64 (MO_Eq W64) MO_x64_Eq
+ Word64GeOp -> opTranslate64 (MO_U_Ge W64) MO_W64_Ge
+ Word64GtOp -> opTranslate64 (MO_U_Gt W64) MO_W64_Gt
+ Word64LeOp -> opTranslate64 (MO_U_Le W64) MO_W64_Le
+ Word64LtOp -> opTranslate64 (MO_U_Lt W64) MO_W64_Lt
+ Word64NeOp -> opTranslate64 (MO_Ne W64) MO_x64_Ne
-- Char# ops
- CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth platform))
- CharNeOp -> \args -> opTranslate args (MO_Ne (wordWidth platform))
- CharGeOp -> \args -> opTranslate args (MO_U_Ge (wordWidth platform))
- CharLeOp -> \args -> opTranslate args (MO_U_Le (wordWidth platform))
- CharGtOp -> \args -> opTranslate args (MO_U_Gt (wordWidth platform))
- CharLtOp -> \args -> opTranslate args (MO_U_Lt (wordWidth platform))
+ CharEqOp -> opTranslate (MO_Eq (wordWidth platform))
+ CharNeOp -> opTranslate (MO_Ne (wordWidth platform))
+ CharGeOp -> opTranslate (MO_U_Ge (wordWidth platform))
+ CharLeOp -> opTranslate (MO_U_Le (wordWidth platform))
+ CharGtOp -> opTranslate (MO_U_Gt (wordWidth platform))
+ CharLtOp -> opTranslate (MO_U_Lt (wordWidth platform))
-- Double ops
- DoubleEqOp -> \args -> opTranslate args (MO_F_Eq W64)
- DoubleNeOp -> \args -> opTranslate args (MO_F_Ne W64)
- DoubleGeOp -> \args -> opTranslate args (MO_F_Ge W64)
- DoubleLeOp -> \args -> opTranslate args (MO_F_Le W64)
- DoubleGtOp -> \args -> opTranslate args (MO_F_Gt W64)
- DoubleLtOp -> \args -> opTranslate args (MO_F_Lt W64)
+ DoubleEqOp -> opTranslate (MO_F_Eq W64)
+ DoubleNeOp -> opTranslate (MO_F_Ne W64)
+ DoubleGeOp -> opTranslate (MO_F_Ge W64)
+ DoubleLeOp -> opTranslate (MO_F_Le W64)
+ DoubleGtOp -> opTranslate (MO_F_Gt W64)
+ DoubleLtOp -> opTranslate (MO_F_Lt W64)
- DoubleAddOp -> \args -> opTranslate args (MO_F_Add W64)
- DoubleSubOp -> \args -> opTranslate args (MO_F_Sub W64)
- DoubleMulOp -> \args -> opTranslate args (MO_F_Mul W64)
- DoubleDivOp -> \args -> opTranslate args (MO_F_Quot W64)
- DoubleNegOp -> \args -> opTranslate args (MO_F_Neg W64)
+ DoubleAddOp -> opTranslate (MO_F_Add W64)
+ DoubleSubOp -> opTranslate (MO_F_Sub W64)
+ DoubleMulOp -> opTranslate (MO_F_Mul W64)
+ DoubleDivOp -> opTranslate (MO_F_Quot W64)
+ DoubleNegOp -> opTranslate (MO_F_Neg W64)
DoubleFMAdd -> fmaOp FMAdd W64
DoubleFMSub -> fmaOp FMSub W64
@@ -1497,18 +1505,18 @@ emitPrimOp cfg primop =
-- Float ops
- FloatEqOp -> \args -> opTranslate args (MO_F_Eq W32)
- FloatNeOp -> \args -> opTranslate args (MO_F_Ne W32)
- FloatGeOp -> \args -> opTranslate args (MO_F_Ge W32)
- FloatLeOp -> \args -> opTranslate args (MO_F_Le W32)
- FloatGtOp -> \args -> opTranslate args (MO_F_Gt W32)
- FloatLtOp -> \args -> opTranslate args (MO_F_Lt W32)
+ FloatEqOp -> opTranslate (MO_F_Eq W32)
+ FloatNeOp -> opTranslate (MO_F_Ne W32)
+ FloatGeOp -> opTranslate (MO_F_Ge W32)
+ FloatLeOp -> opTranslate (MO_F_Le W32)
+ FloatGtOp -> opTranslate (MO_F_Gt W32)
+ FloatLtOp -> opTranslate (MO_F_Lt W32)
- FloatAddOp -> \args -> opTranslate args (MO_F_Add W32)
- FloatSubOp -> \args -> opTranslate args (MO_F_Sub W32)
- FloatMulOp -> \args -> opTranslate args (MO_F_Mul W32)
- FloatDivOp -> \args -> opTranslate args (MO_F_Quot W32)
- FloatNegOp -> \args -> opTranslate args (MO_F_Neg W32)
+ FloatAddOp -> opTranslate (MO_F_Add W32)
+ FloatSubOp -> opTranslate (MO_F_Sub W32)
+ FloatMulOp -> opTranslate (MO_F_Mul W32)
+ FloatDivOp -> opTranslate (MO_F_Quot W32)
+ FloatNegOp -> opTranslate (MO_F_Neg W32)
FloatFMAdd -> fmaOp FMAdd W32
FloatFMSub -> fmaOp FMSub W32
@@ -1517,126 +1525,122 @@ emitPrimOp cfg primop =
-- Vector ops
- (VecAddOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Add n w)
- (VecSubOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Sub n w)
- (VecMulOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Mul n w)
- (VecDivOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Quot n w)
+ (VecAddOp FloatVec n w) -> opTranslate (MO_VF_Add n w)
+ (VecSubOp FloatVec n w) -> opTranslate (MO_VF_Sub n w)
+ (VecMulOp FloatVec n w) -> opTranslate (MO_VF_Mul n w)
+ (VecDivOp FloatVec n w) -> opTranslate (MO_VF_Quot n w)
(VecQuotOp FloatVec _ _) -> \_ -> panic "unsupported primop"
(VecRemOp FloatVec _ _) -> \_ -> panic "unsupported primop"
- (VecNegOp FloatVec n w) -> \args -> opTranslate args (MO_VF_Neg n w)
+ (VecNegOp FloatVec n w) -> opTranslate (MO_VF_Neg n w)
- (VecAddOp IntVec n w) -> \args -> opTranslate args (MO_V_Add n w)
- (VecSubOp IntVec n w) -> \args -> opTranslate args (MO_V_Sub n w)
- (VecMulOp IntVec n w) -> \args -> opTranslate args (MO_V_Mul n w)
+ (VecAddOp IntVec n w) -> opTranslate (MO_V_Add n w)
+ (VecSubOp IntVec n w) -> opTranslate (MO_V_Sub n w)
+ (VecMulOp IntVec n w) -> opTranslate (MO_V_Mul n w)
(VecDivOp IntVec _ _) -> \_ -> panic "unsupported primop"
- (VecQuotOp IntVec n w) -> \args -> opTranslate args (MO_VS_Quot n w)
- (VecRemOp IntVec n w) -> \args -> opTranslate args (MO_VS_Rem n w)
- (VecNegOp IntVec n w) -> \args -> opTranslate args (MO_VS_Neg n w)
+ (VecQuotOp IntVec n w) -> opTranslate (MO_VS_Quot n w)
+ (VecRemOp IntVec n w) -> opTranslate (MO_VS_Rem n w)
+ (VecNegOp IntVec n w) -> opTranslate (MO_VS_Neg n w)
- (VecAddOp WordVec n w) -> \args -> opTranslate args (MO_V_Add n w)
- (VecSubOp WordVec n w) -> \args -> opTranslate args (MO_V_Sub n w)
- (VecMulOp WordVec n w) -> \args -> opTranslate args (MO_V_Mul n w)
+ (VecAddOp WordVec n w) -> opTranslate (MO_V_Add n w)
+ (VecSubOp WordVec n w) -> opTranslate (MO_V_Sub n w)
+ (VecMulOp WordVec n w) -> opTranslate (MO_V_Mul n w)
(VecDivOp WordVec _ _) -> \_ -> panic "unsupported primop"
- (VecQuotOp WordVec n w) -> \args -> opTranslate args (MO_VU_Quot n w)
- (VecRemOp WordVec n w) -> \args -> opTranslate args (MO_VU_Rem n w)
+ (VecQuotOp WordVec n w) -> opTranslate (MO_VU_Quot n w)
+ (VecRemOp WordVec n w) -> opTranslate (MO_VU_Rem n w)
(VecNegOp WordVec _ _) -> \_ -> panic "unsupported primop"
-- Conversions
- IntToDoubleOp -> \args -> opTranslate args (MO_SF_Round (wordWidth platform) W64)
- DoubleToIntOp -> \args -> opTranslate args (MO_FS_Truncate W64 (wordWidth platform))
+ IntToDoubleOp -> opTranslate (MO_SF_Round (wordWidth platform) W64)
+ DoubleToIntOp -> opTranslate (MO_FS_Truncate W64 (wordWidth platform))
- IntToFloatOp -> \args -> opTranslate args (MO_SF_Round (wordWidth platform) W32)
- FloatToIntOp -> \args -> opTranslate args (MO_FS_Truncate W32 (wordWidth platform))
+ IntToFloatOp -> opTranslate (MO_SF_Round (wordWidth platform) W32)
+ FloatToIntOp -> opTranslate (MO_FS_Truncate W32 (wordWidth platform))
- FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64)
- DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32)
+ FloatToDoubleOp -> opTranslate (MO_FF_Conv W32 W64)
+ DoubleToFloatOp -> opTranslate (MO_FF_Conv W64 W32)
- CastFloatToWord32Op ->
- \args -> translateBitcasts (MO_FW_Bitcast W32) args
- CastWord32ToFloatOp ->
- \args -> translateBitcasts (MO_WF_Bitcast W32) args
- CastDoubleToWord64Op ->
- \args -> translateBitcasts (MO_FW_Bitcast W64) args
- CastWord64ToDoubleOp ->
- \args -> translateBitcasts (MO_WF_Bitcast W64) args
+ CastFloatToWord32Op -> translateBitcasts (MO_FW_Bitcast W32)
+ CastWord32ToFloatOp -> translateBitcasts (MO_WF_Bitcast W32)
+ CastDoubleToWord64Op -> translateBitcasts (MO_FW_Bitcast W64)
+ CastWord64ToDoubleOp -> translateBitcasts (MO_WF_Bitcast W64)
- IntQuotRemOp -> \args -> opCallishHandledLater args $
+ IntQuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_S_QuotRem (wordWidth platform))
else Right (genericIntQuotRemOp (wordWidth platform))
- Int8QuotRemOp -> \args -> opCallishHandledLater args $
+ Int8QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_S_QuotRem W8)
else Right (genericIntQuotRemOp W8)
- Int16QuotRemOp -> \args -> opCallishHandledLater args $
+ Int16QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_S_QuotRem W16)
else Right (genericIntQuotRemOp W16)
- Int32QuotRemOp -> \args -> opCallishHandledLater args $
+ Int32QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_S_QuotRem W32)
else Right (genericIntQuotRemOp W32)
- WordQuotRemOp -> \args -> opCallishHandledLater args $
+ WordQuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_U_QuotRem (wordWidth platform))
else Right (genericWordQuotRemOp (wordWidth platform))
- WordQuotRem2Op -> \args -> opCallishHandledLater args $
+ WordQuotRem2Op -> opCallishHandledLater $
if allowQuotRem2
then Left (MO_U_QuotRem2 (wordWidth platform))
else Right (genericWordQuotRem2Op platform)
- Word8QuotRemOp -> \args -> opCallishHandledLater args $
+ Word8QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_U_QuotRem W8)
else Right (genericWordQuotRemOp W8)
- Word16QuotRemOp -> \args -> opCallishHandledLater args $
+ Word16QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_U_QuotRem W16)
else Right (genericWordQuotRemOp W16)
- Word32QuotRemOp -> \args -> opCallishHandledLater args $
+ Word32QuotRemOp -> opCallishHandledLater $
if allowQuotRem
then Left (MO_U_QuotRem W32)
else Right (genericWordQuotRemOp W32)
- WordAdd2Op -> \args -> opCallishHandledLater args $
+ WordAdd2Op -> opCallishHandledLater $
if allowExtAdd
then Left (MO_Add2 (wordWidth platform))
else Right genericWordAdd2Op
- WordAddCOp -> \args -> opCallishHandledLater args $
+ WordAddCOp -> opCallishHandledLater $
if allowExtAdd
then Left (MO_AddWordC (wordWidth platform))
else Right genericWordAddCOp
- WordSubCOp -> \args -> opCallishHandledLater args $
+ WordSubCOp -> opCallishHandledLater $
if allowExtAdd
then Left (MO_SubWordC (wordWidth platform))
else Right genericWordSubCOp
- IntAddCOp -> \args -> opCallishHandledLater args $
+ IntAddCOp -> opCallishHandledLater $
if allowExtAdd
then Left (MO_AddIntC (wordWidth platform))
else Right genericIntAddCOp
- IntSubCOp -> \args -> opCallishHandledLater args $
+ IntSubCOp -> opCallishHandledLater $
if allowExtAdd
then Left (MO_SubIntC (wordWidth platform))
else Right genericIntSubCOp
- WordMul2Op -> \args -> opCallishHandledLater args $
+ WordMul2Op -> opCallishHandledLater $
if allowWord2Mul
then Left (MO_U_Mul2 (wordWidth platform))
else Right genericWordMul2Op
- IntMul2Op -> \args -> opCallishHandledLater args $
+ IntMul2Op -> opCallishHandledLater $
if allowInt2Mul
then Left (MO_S_Mul2 (wordWidth platform))
else Right genericIntMul2Op
@@ -1775,42 +1779,33 @@ emitPrimOp cfg primop =
-- These primops are implemented by CallishMachOps, because they sometimes
-- turn into foreign calls depending on the backend.
- opCallish :: [CmmExpr] -> CallishMachOp -> PrimopCmmEmit
- opCallish args prim = opIntoRegs $ \[res] -> emitPrimCall [res] prim args
+ opCallish :: CallishMachOp -> [CmmExpr] -> PrimopCmmEmit
+ opCallish prim args = opIntoRegs $ \[res] -> emitPrimCall [res] prim args
- opTranslate :: [CmmExpr] -> MachOp -> PrimopCmmEmit
- opTranslate args mop = opIntoRegs $ \[res] -> do
+ opTranslate :: MachOp -> [CmmExpr] -> PrimopCmmEmit
+ opTranslate mop args = opIntoRegs $ \[res] -> do
let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args)
emit stmt
- isQuottishOp :: CallishMachOp -> Bool
- isQuottishOp MO_I64_Quot = True
- isQuottishOp MO_I64_Rem = True
- isQuottishOp MO_W64_Quot = True
- isQuottishOp MO_W64_Rem = True
- isQuottishOp _ = False
-
opTranslate64
- :: [CmmExpr]
- -> (Width -> MachOp)
+ :: MachOp
-> CallishMachOp
+ -> [CmmExpr]
-> PrimopCmmEmit
- opTranslate64 args mkMop callish =
- case platformWordSize platform of
- -- LLVM and C `can handle larger than native size arithmetic natively.
- _ | not (isQuottishOp callish), stgToCmmAllowBigArith cfg -> opTranslate args $ mkMop W64
- | isQuottishOp callish, stgToCmmAllowBigQuot cfg -> opTranslate args $ mkMop W64
- PW4 -> opCallish args callish
- PW8 -> opTranslate args $ mkMop W64
+ opTranslate64 mop callish
+ | allowArith64 = opTranslate mop
+ | otherwise = opCallish callish
+ -- backends not supporting 64-bit arithmetic primops: use callish machine
+ -- ops
-- Basically a "manual" case, rather than one of the common repetitive forms
-- above. The results are a parameter to the returned function so we know the
-- choice of variant never depends on them.
opCallishHandledLater
- :: [CmmExpr]
- -> Either CallishMachOp GenericOp
+ :: Either CallishMachOp GenericOp
+ -> [CmmExpr]
-> PrimopCmmEmit
- opCallishHandledLater args callOrNot = opIntoRegs $ \res0 -> case callOrNot of
+ opCallishHandledLater callOrNot args = opIntoRegs $ \res0 -> case callOrNot of
Left op -> emit $ mkUnsafeCall (PrimTarget op) res0 args
Right gen -> gen res0 args
@@ -1838,21 +1833,23 @@ emitPrimOp cfg primop =
allowExtAdd = stgToCmmAllowExtendedAddSubInstrs cfg
allowInt2Mul = stgToCmmAllowIntMul2Instr cfg
allowWord2Mul = stgToCmmAllowWordMul2Instr cfg
+ allowArith64 = stgToCmmAllowArith64 cfg
+ allowQuot64 = stgToCmmAllowQuot64 cfg
-- a bit of a hack, for certain code generaters, e.g. PPC, and i386 we
-- continue to use the cmm versions of these functions instead of inline
-- assembly. Tracked in #24841.
ppc = isPPC $ platformArch platform
i386 = target32Bit platform
- translateBitcasts mop args | ppc || i386 = alwaysExternal args
- | otherwise = opTranslate args mop
+ translateBitcasts mop | ppc || i386 = alwaysExternal
+ | otherwise = opTranslate mop
allowFMA = stgToCmmAllowFMAInstr cfg
fmaOp :: FMASign -> Width -> [CmmActual] -> PrimopCmmEmit
fmaOp signs w args@[arg_x, arg_y, arg_z]
| allowFMA signs
- = opTranslate args (MO_FMA signs w)
+ = opTranslate (MO_FMA signs w) args
| otherwise
= case signs of
=====================================
libraries/base/changelog.md
=====================================
@@ -3,6 +3,7 @@
## 4.21.0.0 *TBA*
* Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))
* Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
+ * Make `flip` representation polymorphic ([CLC proposal #245](https://github.com/haskell/core-libraries-committee/issues/245))
* The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))
* Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
* Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -2184,7 +2184,7 @@ const x _ = x
--
-- >>> let (.>) = flip (.) in (+1) .> show $ 5
-- "6"
-flip :: (a -> b -> c) -> b -> a -> c
+flip :: forall repc a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
flip f x y = f y x
-- Note: Before base-4.19, ($) was not representation polymorphic
=====================================
testsuite/tests/driver/objc/all.T
=====================================
@@ -1,11 +1,13 @@
test('objc-hi',
[ unless(opsys('darwin'), skip),
+ when(config.target_wrapper is not None, skip),
objc_src,
expect_fail_for(['ghci']) ],
compile_and_run, ['-framework Foundation'])
test('objcxx-hi',
[ unless(opsys('darwin'), skip),
+ when(config.target_wrapper is not None, skip),
objcxx_src,
expect_fail_for(['ghci']) ],
compile_and_run, ['-framework Foundation -lc++'])
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1095,7 +1095,7 @@ module Data.Function where
applyWhen :: forall a. GHC.Types.Bool -> (a -> a) -> a -> a
const :: forall a b. a -> b -> a
fix :: forall a. (a -> a) -> a
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
id :: forall a. a -> a
on :: forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
@@ -3714,7 +3714,7 @@ module GHC.Base where
fetchXorIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorWordAddr# :: forall d. Addr# -> Word# -> State# d -> (# State# d, Word# #)
finalizeWeak# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #)
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
float2Double# :: Float# -> Double#
float2Int# :: Float# -> Int#
fmaddDouble# :: Double# -> Double# -> Double# -> Double#
@@ -10127,7 +10127,7 @@ module Prelude where
errorWithoutStackTrace :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r). [Char] -> a
even :: forall a. Integral a => a -> Bool
filter :: forall a. (a -> Bool) -> [a] -> [a]
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
fromIntegral :: forall a b. (Integral a, Num b) => a -> b
fst :: forall a b. (a, b) -> a
gcd :: forall a. Integral a => a -> a -> a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1095,7 +1095,7 @@ module Data.Function where
applyWhen :: forall a. GHC.Types.Bool -> (a -> a) -> a -> a
const :: forall a b. a -> b -> a
fix :: forall a. (a -> a) -> a
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
id :: forall a. a -> a
on :: forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
@@ -3714,7 +3714,7 @@ module GHC.Base where
fetchXorIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorWordAddr# :: forall d. Addr# -> Word# -> State# d -> (# State# d, Word# #)
finalizeWeak# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #)
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
float2Double# :: Float# -> Double#
float2Int# :: Float# -> Int#
fmaddDouble# :: Double# -> Double# -> Double# -> Double#
@@ -13169,7 +13169,7 @@ module Prelude where
errorWithoutStackTrace :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r). [Char] -> a
even :: forall a. Integral a => a -> Bool
filter :: forall a. (a -> Bool) -> [a] -> [a]
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
fromIntegral :: forall a b. (Integral a, Num b) => a -> b
fst :: forall a b. (a, b) -> a
gcd :: forall a. Integral a => a -> a -> a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1095,7 +1095,7 @@ module Data.Function where
applyWhen :: forall a. GHC.Types.Bool -> (a -> a) -> a -> a
const :: forall a b. a -> b -> a
fix :: forall a. (a -> a) -> a
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
id :: forall a. a -> a
on :: forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
@@ -3717,7 +3717,7 @@ module GHC.Base where
fetchXorIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorWordAddr# :: forall d. Addr# -> Word# -> State# d -> (# State# d, Word# #)
finalizeWeak# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #)
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
float2Double# :: Float# -> Double#
float2Int# :: Float# -> Int#
fmaddDouble# :: Double# -> Double# -> Double# -> Double#
@@ -10413,7 +10413,7 @@ module Prelude where
errorWithoutStackTrace :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r). [Char] -> a
even :: forall a. Integral a => a -> Bool
filter :: forall a. (a -> Bool) -> [a] -> [a]
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
fromIntegral :: forall a b. (Integral a, Num b) => a -> b
fst :: forall a b. (a, b) -> a
gcd :: forall a. Integral a => a -> a -> a
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1095,7 +1095,7 @@ module Data.Function where
applyWhen :: forall a. GHC.Types.Bool -> (a -> a) -> a -> a
const :: forall a b. a -> b -> a
fix :: forall a. (a -> a) -> a
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
id :: forall a. a -> a
on :: forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
@@ -3714,7 +3714,7 @@ module GHC.Base where
fetchXorIntArray# :: forall d. MutableByteArray# d -> Int# -> Int# -> State# d -> (# State# d, Int# #)
fetchXorWordAddr# :: forall d. Addr# -> Word# -> State# d -> (# State# d, Word# #)
finalizeWeak# :: forall {l :: Levity} (a :: TYPE (BoxedRep l)) b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #)
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
float2Double# :: Float# -> Double#
float2Int# :: Float# -> Int#
fmaddDouble# :: Double# -> Double# -> Double# -> Double#
@@ -10127,7 +10127,7 @@ module Prelude where
errorWithoutStackTrace :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r). [Char] -> a
even :: forall a. Integral a => a -> Bool
filter :: forall a. (a -> Bool) -> [a] -> [a]
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ flip :: forall (repc :: GHC.Types.RuntimeRep) a b (c :: TYPE repc). (a -> b -> c) -> b -> a -> c
fromIntegral :: forall a b. (Integral a, Num b) => a -> b
fst :: forall a b. (a, b) -> a
gcd :: forall a. Integral a => a -> a -> a
=====================================
testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
=====================================
@@ -39,14 +39,14 @@ abstract_refinement_hole_fits.hs:4:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where const :: forall a b. a -> b -> a
(.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
- where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
($) (_ :: [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
($!) (_ :: [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
+ flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
+ where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
id (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where id :: forall a. a -> a
head (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0)
@@ -160,22 +160,22 @@ abstract_refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -W
where foldr :: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
- flip (_ :: [Integer] -> Integer -> Integer)
- where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
curry (_ :: (Integer, [Integer]) -> Integer)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
const (_ :: [Integer] -> Integer)
where const :: forall a b. a -> b -> a
+ flip (_ :: [Integer] -> Integer -> Integer)
+ where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
(.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1)
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
- where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
($) (_ :: Integer -> [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
($!) (_ :: Integer -> [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
+ flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
+ where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
id (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where id :: forall a. a -> a
head (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0)
=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -194,7 +194,6 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
seq :: forall a b. a -> b -> b
($!) :: forall a b. (a -> b) -> a -> b
(.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
@@ -202,5 +201,6 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
($) :: forall a b. (a -> b) -> a -> b
+ flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -197,7 +197,6 @@ holes3.hs:11:15: error: [GHC-88464]
seq :: forall a b. a -> b -> b
($!) :: forall a b. (a -> b) -> a -> b
(.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
@@ -205,5 +204,6 @@ holes3.hs:11:15: error: [GHC-88464]
zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
($) :: forall a b. (a -> b) -> a -> b
+ flip :: forall a b c. (a -> b -> c) -> b -> a -> c
zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
=====================================
testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
=====================================
@@ -172,11 +172,6 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with foldr @[] @Integer @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Internal.Data.Foldable’))
- flip (_ :: [Integer] -> Integer -> Integer)
- where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
- with flip @[Integer] @Integer @Integer
- (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
- (and originally defined in ‘GHC.Internal.Base’))
curry (_ :: (Integer, [Integer]) -> Integer)
where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c
with curry @Integer @[Integer] @Integer
@@ -187,6 +182,11 @@ refinement_hole_fits.hs:7:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
with const @([Integer] -> Integer) @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Internal.Base’))
+ flip (_ :: [Integer] -> Integer -> Integer)
+ where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ with flip @GHC.Types.LiftedRep @[Integer] @Integer @Integer
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘GHC.Internal.Base’))
($) (_ :: Integer -> [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
with ($) @GHC.Types.LiftedRep
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9fd1fc3a09e6d8b02f72d90212f8b00a7b9abf8...edbec6d40aa7ff39f87ea7e75a4cc3f5cbe07d8f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9fd1fc3a09e6d8b02f72d90212f8b00a7b9abf8...edbec6d40aa7ff39f87ea7e75a4cc3f5cbe07d8f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240607/b136ffc9/attachment-0001.html>
More information about the ghc-commits
mailing list