[Git][ghc/ghc][master] primops: Remove Monadic and Dyadic categories
Marge Bot
gitlab at gitlab.haskell.org
Wed Aug 26 14:43:20 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00
primops: Remove Monadic and Dyadic categories
There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp.
The compiler does not treat Monadic and Dyadic in any special way,
we can just replace them with GenPrimOp.
Compare is still used in isComparisonPrimOp.
- - - - -
8 changed files:
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Prim.hs
- utils/genprimopcode/Lexer.x
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Parser.y
- utils/genprimopcode/ParserM.hs
- utils/genprimopcode/Syntax.hs
Changes:
=====================================
compiler/GHC/Builtin/PrimOps.hs
=====================================
@@ -38,7 +38,7 @@ import GHC.Types.Name
import GHC.Builtin.Names ( gHC_PRIMOPWRAPPERS )
import GHC.Core.TyCon ( TyCon, isPrimTyCon, PrimRep(..) )
import GHC.Core.Type
-import GHC.Types.RepType ( typePrimRep1, tyConPrimRep1 )
+import GHC.Types.RepType ( tyConPrimRep1 )
import GHC.Types.Basic ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
SourceText(..) )
import GHC.Types.SrcLoc ( wiredInSrcSpan )
@@ -103,33 +103,17 @@ tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)
\subsection[PrimOp-info]{The essential info about each @PrimOp@}
* *
************************************************************************
-
-The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
-refer to the primitive operation. The conventional \tr{#}-for-
-unboxed ops is added on later.
-
-The reason for the funny characters in the names is so we do not
-interfere with the programmer's Haskell name spaces.
-
-We use @PrimKinds@ for the ``type'' information, because they're
-(slightly) more convenient to use than @TyCons at .
-}
data PrimOpInfo
- = Dyadic OccName -- string :: T -> T -> T
- Type
- | Monadic OccName -- string :: T -> T
- Type
- | Compare OccName -- string :: T -> T -> Int#
+ = Compare OccName -- string :: T -> T -> Int#
Type
| GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
[TyVar]
[Type]
Type
-mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo
-mkDyadic str ty = Dyadic (mkVarOccFS str) ty
-mkMonadic str ty = Monadic (mkVarOccFS str) ty
+mkCompare :: FastString -> Type -> PrimOpInfo
mkCompare str ty = Compare (mkVarOccFS str) ty
mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo
@@ -575,8 +559,6 @@ primOpCodeSizeForeignCall = 4
primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
primOpType op
= case primOpInfo op of
- Dyadic _occ ty -> dyadic_fun_ty ty
- Monadic _occ ty -> monadic_fun_ty ty
Compare _occ ty -> compare_fun_ty ty
GenPrimOp _occ tyvars arg_tys res_ty ->
@@ -585,15 +567,11 @@ primOpType op
primOpResultType :: PrimOp -> Type
primOpResultType op
= case primOpInfo op of
- Dyadic _occ ty -> ty
- Monadic _occ ty -> ty
Compare _occ _ty -> intPrimTy
GenPrimOp _occ _tyvars _arg_tys res_ty -> res_ty
primOpOcc :: PrimOp -> OccName
primOpOcc op = case primOpInfo op of
- Dyadic occ _ -> occ
- Monadic occ _ -> occ
Compare occ _ -> occ
GenPrimOp occ _ _ _ -> occ
@@ -692,8 +670,8 @@ primOpWrapperId op = mkVanillaGlobalWithInfo name ty info
isComparisonPrimOp :: PrimOp -> Bool
isComparisonPrimOp op = case primOpInfo op of
- Compare {} -> True
- _ -> False
+ Compare {} -> True
+ GenPrimOp {} -> False
-- primOpSig is like primOpType but gives the result split apart:
-- (type variables, argument types, result type)
@@ -706,8 +684,6 @@ primOpSig op
arity = length arg_tys
(tyvars, arg_tys, res_ty)
= case (primOpInfo op) of
- Monadic _occ ty -> ([], [ty], ty )
- Dyadic _occ ty -> ([], [ty,ty], ty )
Compare _occ ty -> ([], [ty,ty], intPrimTy)
GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty )
@@ -722,8 +698,6 @@ data PrimOpResultInfo
getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
getPrimOpResultInfo op
= case (primOpInfo op) of
- Dyadic _ ty -> ReturnsPrim (typePrimRep1 ty)
- Monadic _ ty -> ReturnsPrim (typePrimRep1 ty)
Compare _ _ -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)
GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)
| otherwise -> ReturnsAlg tc
@@ -747,9 +721,7 @@ commutableOp :: PrimOp -> Bool
-- Utils:
-dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
-dyadic_fun_ty ty = mkVisFunTysMany [ty, ty] ty
-monadic_fun_ty ty = mkVisFunTyMany ty ty
+compare_fun_ty :: Type -> Type
compare_fun_ty ty = mkVisFunTysMany [ty, ty] intPrimTy
-- Output stuff:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -42,11 +42,9 @@
-- (eg, out_of_line), whilst avoiding parsing complex expressions
-- needed for strictness info.
--
--- type refers to the general category of the primop. Valid settings include,
+-- type refers to the general category of the primop. There are only two:
--
-- * Compare: A comparison operation of the shape a -> a -> Int#
--- * Monadic: A unary operation of shape a -> a
--- * Dyadic: A binary operation of shape a -> a -> a
-- * GenPrimOp: Any other sort of primop
--
@@ -238,23 +236,23 @@ primtype Int8#
primop Int8Extend "extendInt8#" GenPrimOp Int8# -> Int#
primop Int8Narrow "narrowInt8#" GenPrimOp Int# -> Int8#
-primop Int8NegOp "negateInt8#" Monadic Int8# -> Int8#
+primop Int8NegOp "negateInt8#" GenPrimOp Int8# -> Int8#
-primop Int8AddOp "plusInt8#" Dyadic Int8# -> Int8# -> Int8#
+primop Int8AddOp "plusInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
commutable = True
-primop Int8SubOp "subInt8#" Dyadic Int8# -> Int8# -> Int8#
+primop Int8SubOp "subInt8#" GenPrimOp Int8# -> Int8# -> Int8#
-primop Int8MulOp "timesInt8#" Dyadic Int8# -> Int8# -> Int8#
+primop Int8MulOp "timesInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
commutable = True
-primop Int8QuotOp "quotInt8#" Dyadic Int8# -> Int8# -> Int8#
+primop Int8QuotOp "quotInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
can_fail = True
-primop Int8RemOp "remInt8#" Dyadic Int8# -> Int8# -> Int8#
+primop Int8RemOp "remInt8#" GenPrimOp Int8# -> Int8# -> Int8#
with
can_fail = True
@@ -279,23 +277,23 @@ primtype Word8#
primop Word8Extend "extendWord8#" GenPrimOp Word8# -> Word#
primop Word8Narrow "narrowWord8#" GenPrimOp Word# -> Word8#
-primop Word8NotOp "notWord8#" Monadic Word8# -> Word8#
+primop Word8NotOp "notWord8#" GenPrimOp Word8# -> Word8#
-primop Word8AddOp "plusWord8#" Dyadic Word8# -> Word8# -> Word8#
+primop Word8AddOp "plusWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
commutable = True
-primop Word8SubOp "subWord8#" Dyadic Word8# -> Word8# -> Word8#
+primop Word8SubOp "subWord8#" GenPrimOp Word8# -> Word8# -> Word8#
-primop Word8MulOp "timesWord8#" Dyadic Word8# -> Word8# -> Word8#
+primop Word8MulOp "timesWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
commutable = True
-primop Word8QuotOp "quotWord8#" Dyadic Word8# -> Word8# -> Word8#
+primop Word8QuotOp "quotWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
can_fail = True
-primop Word8RemOp "remWord8#" Dyadic Word8# -> Word8# -> Word8#
+primop Word8RemOp "remWord8#" GenPrimOp Word8# -> Word8# -> Word8#
with
can_fail = True
@@ -320,23 +318,23 @@ primtype Int16#
primop Int16Extend "extendInt16#" GenPrimOp Int16# -> Int#
primop Int16Narrow "narrowInt16#" GenPrimOp Int# -> Int16#
-primop Int16NegOp "negateInt16#" Monadic Int16# -> Int16#
+primop Int16NegOp "negateInt16#" GenPrimOp Int16# -> Int16#
-primop Int16AddOp "plusInt16#" Dyadic Int16# -> Int16# -> Int16#
+primop Int16AddOp "plusInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
commutable = True
-primop Int16SubOp "subInt16#" Dyadic Int16# -> Int16# -> Int16#
+primop Int16SubOp "subInt16#" GenPrimOp Int16# -> Int16# -> Int16#
-primop Int16MulOp "timesInt16#" Dyadic Int16# -> Int16# -> Int16#
+primop Int16MulOp "timesInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
commutable = True
-primop Int16QuotOp "quotInt16#" Dyadic Int16# -> Int16# -> Int16#
+primop Int16QuotOp "quotInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
can_fail = True
-primop Int16RemOp "remInt16#" Dyadic Int16# -> Int16# -> Int16#
+primop Int16RemOp "remInt16#" GenPrimOp Int16# -> Int16# -> Int16#
with
can_fail = True
@@ -361,23 +359,23 @@ primtype Word16#
primop Word16Extend "extendWord16#" GenPrimOp Word16# -> Word#
primop Word16Narrow "narrowWord16#" GenPrimOp Word# -> Word16#
-primop Word16NotOp "notWord16#" Monadic Word16# -> Word16#
+primop Word16NotOp "notWord16#" GenPrimOp Word16# -> Word16#
-primop Word16AddOp "plusWord16#" Dyadic Word16# -> Word16# -> Word16#
+primop Word16AddOp "plusWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
commutable = True
-primop Word16SubOp "subWord16#" Dyadic Word16# -> Word16# -> Word16#
+primop Word16SubOp "subWord16#" GenPrimOp Word16# -> Word16# -> Word16#
-primop Word16MulOp "timesWord16#" Dyadic Word16# -> Word16# -> Word16#
+primop Word16MulOp "timesWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
commutable = True
-primop Word16QuotOp "quotWord16#" Dyadic Word16# -> Word16# -> Word16#
+primop Word16QuotOp "quotWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
can_fail = True
-primop Word16RemOp "remWord16#" Dyadic Word16# -> Word16# -> Word16#
+primop Word16RemOp "remWord16#" GenPrimOp Word16# -> Word16# -> Word16#
with
can_fail = True
@@ -420,16 +418,16 @@ section "Int#"
primtype Int#
-primop IntAddOp "+#" Dyadic
+primop IntAddOp "+#" GenPrimOp
Int# -> Int# -> Int#
with commutable = True
fixity = infixl 6
-primop IntSubOp "-#" Dyadic Int# -> Int# -> Int#
+primop IntSubOp "-#" GenPrimOp Int# -> Int# -> Int#
with fixity = infixl 6
primop IntMulOp "*#"
- Dyadic Int# -> Int# -> Int#
+ GenPrimOp Int# -> Int# -> Int#
{Low word of signed integer multiply.}
with commutable = True
fixity = infixl 7
@@ -442,7 +440,7 @@ primop IntMul2Op "timesInt2#" GenPrimOp
0#) or not (isHighNeeded = 1#).}
primop IntMulMayOfloOp "mulIntMayOflo#"
- Dyadic Int# -> Int# -> Int#
+ GenPrimOp Int# -> Int# -> Int#
{Return non-zero if there is any possibility that the upper word of a
signed integer multiply might contain useful information. Return
zero only if you are completely sure that no overflow can occur.
@@ -465,14 +463,14 @@ primop IntMulMayOfloOp "mulIntMayOflo#"
}
with commutable = True
-primop IntQuotOp "quotInt#" Dyadic
+primop IntQuotOp "quotInt#" GenPrimOp
Int# -> Int# -> Int#
{Rounds towards zero. The behavior is undefined if the second argument is
zero.
}
with can_fail = True
-primop IntRemOp "remInt#" Dyadic
+primop IntRemOp "remInt#" GenPrimOp
Int# -> Int# -> Int#
{Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}. The
behavior is undefined if the second argument is zero.
@@ -484,22 +482,22 @@ primop IntQuotRemOp "quotRemInt#" GenPrimOp
{Rounds towards zero.}
with can_fail = True
-primop AndIOp "andI#" Dyadic Int# -> Int# -> Int#
+primop AndIOp "andI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "and".}
with commutable = True
-primop OrIOp "orI#" Dyadic Int# -> Int# -> Int#
+primop OrIOp "orI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "or".}
with commutable = True
-primop XorIOp "xorI#" Dyadic Int# -> Int# -> Int#
+primop XorIOp "xorI#" GenPrimOp Int# -> Int# -> Int#
{Bitwise "xor".}
with commutable = True
-primop NotIOp "notI#" Monadic Int# -> Int#
+primop NotIOp "notI#" GenPrimOp Int# -> Int#
{Bitwise "not", also known as the binary complement.}
-primop IntNegOp "negateInt#" Monadic Int# -> Int#
+primop IntNegOp "negateInt#" GenPrimOp Int# -> Int#
{Unary negation.
Since the negative {\tt Int#} range extends one further than the
positive range, {\tt negateInt#} of the most negative number is an
@@ -573,7 +571,7 @@ section "Word#"
primtype Word#
-primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
+primop WordAddOp "plusWord#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
primop WordAddCOp "addWordC#" GenPrimOp Word# -> Word# -> (# Word#, Int# #)
@@ -596,9 +594,9 @@ primop WordAdd2Op "plusWord2#" GenPrimOp Word# -> Word# -> (# Word#, Wor
with code_size = 2
commutable = True
-primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
+primop WordSubOp "minusWord#" GenPrimOp Word# -> Word# -> Word#
-primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
+primop WordMulOp "timesWord#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-- Returns (# high, low #)
@@ -606,10 +604,10 @@ primop WordMul2Op "timesWord2#" GenPrimOp
Word# -> Word# -> (# Word#, Word# #)
with commutable = True
-primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
+primop WordQuotOp "quotWord#" GenPrimOp Word# -> Word# -> Word#
with can_fail = True
-primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
+primop WordRemOp "remWord#" GenPrimOp Word# -> Word# -> Word#
with can_fail = True
primop WordQuotRemOp "quotRemWord#" GenPrimOp
@@ -622,16 +620,16 @@ primop WordQuotRem2Op "quotRemWord2#" GenPrimOp
Requires that high word < divisor.}
with can_fail = True
-primop AndOp "and#" Dyadic Word# -> Word# -> Word#
+primop AndOp "and#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop OrOp "or#" Dyadic Word# -> Word# -> Word#
+primop OrOp "or#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop XorOp "xor#" Dyadic Word# -> Word# -> Word#
+primop XorOp "xor#" GenPrimOp Word# -> Word# -> Word#
with commutable = True
-primop NotOp "not#" Monadic Word# -> Word#
+primop NotOp "not#" GenPrimOp Word# -> Word#
primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
{Shift left logical. Result undefined if shift amount is not
@@ -650,79 +648,79 @@ primop WordNeOp "neWord#" Compare Word# -> Word# -> Int#
primop WordLtOp "ltWord#" Compare Word# -> Word# -> Int#
primop WordLeOp "leWord#" Compare Word# -> Word# -> Int#
-primop PopCnt8Op "popCnt8#" Monadic Word# -> Word#
+primop PopCnt8Op "popCnt8#" GenPrimOp Word# -> Word#
{Count the number of set bits in the lower 8 bits of a word.}
-primop PopCnt16Op "popCnt16#" Monadic Word# -> Word#
+primop PopCnt16Op "popCnt16#" GenPrimOp Word# -> Word#
{Count the number of set bits in the lower 16 bits of a word.}
-primop PopCnt32Op "popCnt32#" Monadic Word# -> Word#
+primop PopCnt32Op "popCnt32#" GenPrimOp Word# -> Word#
{Count the number of set bits in the lower 32 bits of a word.}
primop PopCnt64Op "popCnt64#" GenPrimOp WORD64 -> Word#
{Count the number of set bits in a 64-bit word.}
-primop PopCntOp "popCnt#" Monadic Word# -> Word#
+primop PopCntOp "popCnt#" GenPrimOp Word# -> Word#
{Count the number of set bits in a word.}
-primop Pdep8Op "pdep8#" Dyadic Word# -> Word# -> Word#
+primop Pdep8Op "pdep8#" GenPrimOp Word# -> Word# -> Word#
{Deposit bits to lower 8 bits of a word at locations specified by a mask.}
-primop Pdep16Op "pdep16#" Dyadic Word# -> Word# -> Word#
+primop Pdep16Op "pdep16#" GenPrimOp Word# -> Word# -> Word#
{Deposit bits to lower 16 bits of a word at locations specified by a mask.}
-primop Pdep32Op "pdep32#" Dyadic Word# -> Word# -> Word#
+primop Pdep32Op "pdep32#" GenPrimOp Word# -> Word# -> Word#
{Deposit bits to lower 32 bits of a word at locations specified by a mask.}
primop Pdep64Op "pdep64#" GenPrimOp WORD64 -> WORD64 -> WORD64
{Deposit bits to a word at locations specified by a mask.}
-primop PdepOp "pdep#" Dyadic Word# -> Word# -> Word#
+primop PdepOp "pdep#" GenPrimOp Word# -> Word# -> Word#
{Deposit bits to a word at locations specified by a mask.}
-primop Pext8Op "pext8#" Dyadic Word# -> Word# -> Word#
+primop Pext8Op "pext8#" GenPrimOp Word# -> Word# -> Word#
{Extract bits from lower 8 bits of a word at locations specified by a mask.}
-primop Pext16Op "pext16#" Dyadic Word# -> Word# -> Word#
+primop Pext16Op "pext16#" GenPrimOp Word# -> Word# -> Word#
{Extract bits from lower 16 bits of a word at locations specified by a mask.}
-primop Pext32Op "pext32#" Dyadic Word# -> Word# -> Word#
+primop Pext32Op "pext32#" GenPrimOp Word# -> Word# -> Word#
{Extract bits from lower 32 bits of a word at locations specified by a mask.}
primop Pext64Op "pext64#" GenPrimOp WORD64 -> WORD64 -> WORD64
{Extract bits from a word at locations specified by a mask.}
-primop PextOp "pext#" Dyadic Word# -> Word# -> Word#
+primop PextOp "pext#" GenPrimOp Word# -> Word# -> Word#
{Extract bits from a word at locations specified by a mask.}
-primop Clz8Op "clz8#" Monadic Word# -> Word#
+primop Clz8Op "clz8#" GenPrimOp Word# -> Word#
{Count leading zeros in the lower 8 bits of a word.}
-primop Clz16Op "clz16#" Monadic Word# -> Word#
+primop Clz16Op "clz16#" GenPrimOp Word# -> Word#
{Count leading zeros in the lower 16 bits of a word.}
-primop Clz32Op "clz32#" Monadic Word# -> Word#
+primop Clz32Op "clz32#" GenPrimOp Word# -> Word#
{Count leading zeros in the lower 32 bits of a word.}
primop Clz64Op "clz64#" GenPrimOp WORD64 -> Word#
{Count leading zeros in a 64-bit word.}
-primop ClzOp "clz#" Monadic Word# -> Word#
+primop ClzOp "clz#" GenPrimOp Word# -> Word#
{Count leading zeros in a word.}
-primop Ctz8Op "ctz8#" Monadic Word# -> Word#
+primop Ctz8Op "ctz8#" GenPrimOp Word# -> Word#
{Count trailing zeros in the lower 8 bits of a word.}
-primop Ctz16Op "ctz16#" Monadic Word# -> Word#
+primop Ctz16Op "ctz16#" GenPrimOp Word# -> Word#
{Count trailing zeros in the lower 16 bits of a word.}
-primop Ctz32Op "ctz32#" Monadic Word# -> Word#
+primop Ctz32Op "ctz32#" GenPrimOp Word# -> Word#
{Count trailing zeros in the lower 32 bits of a word.}
primop Ctz64Op "ctz64#" GenPrimOp WORD64 -> Word#
{Count trailing zeros in a 64-bit word.}
-primop CtzOp "ctz#" Monadic Word# -> Word#
+primop CtzOp "ctz#" GenPrimOp Word# -> Word#
{Count trailing zeros in a word.}
-primop BSwap16Op "byteSwap16#" Monadic Word# -> Word#
+primop BSwap16Op "byteSwap16#" GenPrimOp Word# -> Word#
{Swap bytes in the lower 16 bits of a word. The higher bytes are undefined. }
-primop BSwap32Op "byteSwap32#" Monadic Word# -> Word#
+primop BSwap32Op "byteSwap32#" GenPrimOp Word# -> Word#
{Swap bytes in the lower 32 bits of a word. The higher bytes are undefined. }
-primop BSwap64Op "byteSwap64#" Monadic WORD64 -> WORD64
+primop BSwap64Op "byteSwap64#" GenPrimOp WORD64 -> WORD64
{Swap bytes in a 64 bits of a word.}
-primop BSwapOp "byteSwap#" Monadic Word# -> Word#
+primop BSwapOp "byteSwap#" GenPrimOp Word# -> Word#
{Swap bytes in a word.}
-primop BRev8Op "bitReverse8#" Monadic Word# -> Word#
+primop BRev8Op "bitReverse8#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 8-bit word.}
-primop BRev16Op "bitReverse16#" Monadic Word# -> Word#
+primop BRev16Op "bitReverse16#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 16-bit word.}
-primop BRev32Op "bitReverse32#" Monadic Word# -> Word#
+primop BRev32Op "bitReverse32#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a 32-bit word.}
-primop BRev64Op "bitReverse64#" Monadic WORD64 -> WORD64
+primop BRev64Op "bitReverse64#" GenPrimOp WORD64 -> WORD64
{Reverse the order of the bits in a 64-bit word.}
-primop BRevOp "bitReverse#" Monadic Word# -> Word#
+primop BRevOp "bitReverse#" GenPrimOp Word# -> Word#
{Reverse the order of the bits in a word.}
------------------------------------------------------------------------
@@ -730,12 +728,12 @@ section "Narrowings"
{Explicit narrowing of native-sized ints or words.}
------------------------------------------------------------------------
-primop Narrow8IntOp "narrow8Int#" Monadic Int# -> Int#
-primop Narrow16IntOp "narrow16Int#" Monadic Int# -> Int#
-primop Narrow32IntOp "narrow32Int#" Monadic Int# -> Int#
-primop Narrow8WordOp "narrow8Word#" Monadic Word# -> Word#
-primop Narrow16WordOp "narrow16Word#" Monadic Word# -> Word#
-primop Narrow32WordOp "narrow32Word#" Monadic Word# -> Word#
+primop Narrow8IntOp "narrow8Int#" GenPrimOp Int# -> Int#
+primop Narrow16IntOp "narrow16Int#" GenPrimOp Int# -> Int#
+primop Narrow32IntOp "narrow32Int#" GenPrimOp Int# -> Int#
+primop Narrow8WordOp "narrow8Word#" GenPrimOp Word# -> Word#
+primop Narrow16WordOp "narrow16Word#" GenPrimOp Word# -> Word#
+primop Narrow32WordOp "narrow32Word#" GenPrimOp Word# -> Word#
------------------------------------------------------------------------
section "Double#"
@@ -766,27 +764,27 @@ primop DoubleLtOp "<##" Compare Double# -> Double# -> Int#
primop DoubleLeOp "<=##" Compare Double# -> Double# -> Int#
with fixity = infix 4
-primop DoubleAddOp "+##" Dyadic
+primop DoubleAddOp "+##" GenPrimOp
Double# -> Double# -> Double#
with commutable = True
fixity = infixl 6
-primop DoubleSubOp "-##" Dyadic Double# -> Double# -> Double#
+primop DoubleSubOp "-##" GenPrimOp Double# -> Double# -> Double#
with fixity = infixl 6
-primop DoubleMulOp "*##" Dyadic
+primop DoubleMulOp "*##" GenPrimOp
Double# -> Double# -> Double#
with commutable = True
fixity = infixl 7
-primop DoubleDivOp "/##" Dyadic
+primop DoubleDivOp "/##" GenPrimOp
Double# -> Double# -> Double#
with can_fail = True
fixity = infixl 7
-primop DoubleNegOp "negateDouble#" Monadic Double# -> Double#
+primop DoubleNegOp "negateDouble#" GenPrimOp Double# -> Double#
-primop DoubleFabsOp "fabsDouble#" Monadic Double# -> Double#
+primop DoubleFabsOp "fabsDouble#" GenPrimOp Double# -> Double#
primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int#
{Truncates a {\tt Double#} value to the nearest {\tt Int#}.
@@ -795,96 +793,96 @@ primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int#
primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float#
-primop DoubleExpOp "expDouble#" Monadic
+primop DoubleExpOp "expDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleExpM1Op "expm1Double#" Monadic
+primop DoubleExpM1Op "expm1Double#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleLogOp "logDouble#" Monadic
+primop DoubleLogOp "logDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop DoubleLog1POp "log1pDouble#" Monadic
+primop DoubleLog1POp "log1pDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop DoubleSqrtOp "sqrtDouble#" Monadic
+primop DoubleSqrtOp "sqrtDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleSinOp "sinDouble#" Monadic
+primop DoubleSinOp "sinDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleCosOp "cosDouble#" Monadic
+primop DoubleCosOp "cosDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleTanOp "tanDouble#" Monadic
+primop DoubleTanOp "tanDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleAsinOp "asinDouble#" Monadic
+primop DoubleAsinOp "asinDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop DoubleAcosOp "acosDouble#" Monadic
+primop DoubleAcosOp "acosDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop DoubleAtanOp "atanDouble#" Monadic
+primop DoubleAtanOp "atanDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleSinhOp "sinhDouble#" Monadic
+primop DoubleSinhOp "sinhDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleCoshOp "coshDouble#" Monadic
+primop DoubleCoshOp "coshDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleTanhOp "tanhDouble#" Monadic
+primop DoubleTanhOp "tanhDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleAsinhOp "asinhDouble#" Monadic
+primop DoubleAsinhOp "asinhDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleAcoshOp "acoshDouble#" Monadic
+primop DoubleAcoshOp "acoshDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoubleAtanhOp "atanhDouble#" Monadic
+primop DoubleAtanhOp "atanhDouble#" GenPrimOp
Double# -> Double#
with
code_size = { primOpCodeSizeForeignCall }
-primop DoublePowerOp "**##" Dyadic
+primop DoublePowerOp "**##" GenPrimOp
Double# -> Double# -> Double#
{Exponentiation.}
with
@@ -924,119 +922,119 @@ primop FloatNeOp "neFloat#" Compare
primop FloatLtOp "ltFloat#" Compare Float# -> Float# -> Int#
primop FloatLeOp "leFloat#" Compare Float# -> Float# -> Int#
-primop FloatAddOp "plusFloat#" Dyadic
+primop FloatAddOp "plusFloat#" GenPrimOp
Float# -> Float# -> Float#
with commutable = True
-primop FloatSubOp "minusFloat#" Dyadic Float# -> Float# -> Float#
+primop FloatSubOp "minusFloat#" GenPrimOp Float# -> Float# -> Float#
-primop FloatMulOp "timesFloat#" Dyadic
+primop FloatMulOp "timesFloat#" GenPrimOp
Float# -> Float# -> Float#
with commutable = True
-primop FloatDivOp "divideFloat#" Dyadic
+primop FloatDivOp "divideFloat#" GenPrimOp
Float# -> Float# -> Float#
with can_fail = True
-primop FloatNegOp "negateFloat#" Monadic Float# -> Float#
+primop FloatNegOp "negateFloat#" GenPrimOp Float# -> Float#
-primop FloatFabsOp "fabsFloat#" Monadic Float# -> Float#
+primop FloatFabsOp "fabsFloat#" GenPrimOp Float# -> Float#
primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int#
{Truncates a {\tt Float#} value to the nearest {\tt Int#}.
Results are undefined if the truncation if truncation yields
a value outside the range of {\tt Int#}.}
-primop FloatExpOp "expFloat#" Monadic
+primop FloatExpOp "expFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatExpM1Op "expm1Float#" Monadic
+primop FloatExpM1Op "expm1Float#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatLogOp "logFloat#" Monadic
+primop FloatLogOp "logFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop FloatLog1POp "log1pFloat#" Monadic
+primop FloatLog1POp "log1pFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop FloatSqrtOp "sqrtFloat#" Monadic
+primop FloatSqrtOp "sqrtFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatSinOp "sinFloat#" Monadic
+primop FloatSinOp "sinFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatCosOp "cosFloat#" Monadic
+primop FloatCosOp "cosFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatTanOp "tanFloat#" Monadic
+primop FloatTanOp "tanFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatAsinOp "asinFloat#" Monadic
+primop FloatAsinOp "asinFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop FloatAcosOp "acosFloat#" Monadic
+primop FloatAcosOp "acosFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
can_fail = True
-primop FloatAtanOp "atanFloat#" Monadic
+primop FloatAtanOp "atanFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatSinhOp "sinhFloat#" Monadic
+primop FloatSinhOp "sinhFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatCoshOp "coshFloat#" Monadic
+primop FloatCoshOp "coshFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatTanhOp "tanhFloat#" Monadic
+primop FloatTanhOp "tanhFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatAsinhOp "asinhFloat#" Monadic
+primop FloatAsinhOp "asinhFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatAcoshOp "acoshFloat#" Monadic
+primop FloatAcoshOp "acoshFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatAtanhOp "atanhFloat#" Monadic
+primop FloatAtanhOp "atanhFloat#" GenPrimOp
Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
-primop FloatPowerOp "powerFloat#" Dyadic
+primop FloatPowerOp "powerFloat#" GenPrimOp
Float# -> Float# -> Float#
with
code_size = { primOpCodeSizeForeignCall }
@@ -3575,48 +3573,48 @@ primop VecInsertOp "insert#" GenPrimOp
llvm_only = True
vector = ALL_VECTOR_TYPES
-primop VecAddOp "plus#" Dyadic
+primop VecAddOp "plus#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Add two vectors element-wise. }
with commutable = True
llvm_only = True
vector = ALL_VECTOR_TYPES
-primop VecSubOp "minus#" Dyadic
+primop VecSubOp "minus#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Subtract two vectors element-wise. }
with llvm_only = True
vector = ALL_VECTOR_TYPES
-primop VecMulOp "times#" Dyadic
+primop VecMulOp "times#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Multiply two vectors element-wise. }
with commutable = True
llvm_only = True
vector = ALL_VECTOR_TYPES
-primop VecDivOp "divide#" Dyadic
+primop VecDivOp "divide#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Divide two vectors element-wise. }
with can_fail = True
llvm_only = True
vector = FLOAT_VECTOR_TYPES
-primop VecQuotOp "quot#" Dyadic
+primop VecQuotOp "quot#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Rounds towards zero element-wise. }
with can_fail = True
llvm_only = True
vector = INT_VECTOR_TYPES
-primop VecRemOp "rem#" Dyadic
+primop VecRemOp "rem#" GenPrimOp
VECTOR -> VECTOR -> VECTOR
{ Satisfies \texttt{(quot\# x y) times\# y plus\# (rem\# x y) == x}. }
with can_fail = True
llvm_only = True
vector = INT_VECTOR_TYPES
-primop VecNegOp "negate#" Monadic
+primop VecNegOp "negate#" GenPrimOp
VECTOR -> VECTOR
{ Negate element-wise. }
with llvm_only = True
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
#if __GLASGOW_HASKELL__ <= 808
-- GHC 8.10 deprecates this flag, but GHC 8.8 needs it
@@ -1562,19 +1561,17 @@ emitPrimOp dflags primop = case primop of
-> FCode ())
-> PrimopCmmEmit
opIntoRegs f = PrimopCmmEmit_Internal $ \res_ty -> do
- regs <- if
- | ReturnsPrim VoidRep <- result_info
- -> pure []
+ regs <- case result_info of
+ ReturnsPrim VoidRep -> pure []
+ ReturnsPrim rep
+ -> do reg <- newTemp (primRepCmmType platform rep)
+ pure [reg]
- | ReturnsPrim rep <- result_info
- -> do reg <- newTemp (primRepCmmType platform rep)
- pure [reg]
+ ReturnsAlg tycon | isUnboxedTupleTyCon tycon
+ -> do (regs, _hints) <- newUnboxedTupleRegs res_ty
+ pure regs
- | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
- -> do (regs, _hints) <- newUnboxedTupleRegs res_ty
- pure regs
-
- | otherwise -> panic "cgOpApp"
+ _ -> panic "cgOpApp"
f regs
pure $ map (CmmReg . CmmLocal) regs
=====================================
utils/genprimopcode/Lexer.x
=====================================
@@ -44,8 +44,6 @@ words :-
<0> "defaults" { mkT TDefaults }
<0> "True" { mkT TTrue }
<0> "False" { mkT TFalse }
- <0> "Dyadic" { mkT TDyadic }
- <0> "Monadic" { mkT TMonadic }
<0> "Compare" { mkT TCompare }
<0> "GenPrimOp" { mkT TGenPrimOp }
<0> "fixity" { mkT TFixity }
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -836,16 +836,6 @@ mkPOI_RHS_text i
TyF t1 (TyF _ _)
-> "mkCompare " ++ sl_name i ++ ppType t1
_ -> error "Type error in comparison op"
- Monadic
- -> case ty i of
- TyF t1 _
- -> "mkMonadic " ++ sl_name i ++ ppType t1
- _ -> error "Type error in monadic op"
- Dyadic
- -> case ty i of
- TyF t1 (TyF _ _)
- -> "mkDyadic " ++ sl_name i ++ ppType t1
- _ -> error "Type error in dyadic op"
GenPrimOp
-> let (argTys, resTy) = flatTys (ty i)
tvs = nub (tvsIn (ty i))
=====================================
utils/genprimopcode/Parser.y
=====================================
@@ -36,8 +36,6 @@ import Syntax
defaults { TDefaults }
true { TTrue }
false { TFalse }
- dyadic { TDyadic }
- monadic { TMonadic }
compare { TCompare }
genprimop { TGenPrimOp }
fixity { TFixity }
@@ -122,9 +120,7 @@ pWithOptions : with pOptions { $2 }
| {- empty -} { [] }
pCategory :: { Category }
-pCategory : dyadic { Dyadic }
- | monadic { Monadic }
- | compare { Compare }
+pCategory : compare { Compare }
| genprimop { GenPrimOp }
pDesc :: { String }
=====================================
utils/genprimopcode/ParserM.hs
=====================================
@@ -94,8 +94,6 @@ data Token = TEOF
| TDefaults
| TTrue
| TFalse
- | TDyadic
- | TMonadic
| TCompare
| TGenPrimOp
| TThatsAllFolks
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -65,7 +65,7 @@ data Option
-- categorises primops
data Category
- = Dyadic | Monadic | Compare | GenPrimOp
+ = Compare | GenPrimOp
deriving Show
-- types
@@ -155,10 +155,6 @@ sanityPrimOp def_names p
sane_ty :: Category -> Ty -> Bool
sane_ty Compare (TyF t1 (TyF t2 td))
| t1 == t2 && td == TyApp (TyCon "Int#") [] = True
-sane_ty Monadic (TyF t1 td)
- | t1 == td = True
-sane_ty Dyadic (TyF t1 (TyF t2 td))
- | t1 == td && t2 == td = True
sane_ty GenPrimOp _
= True
sane_ty _ _
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/770100e0266750a313b34a52a60968410fcf0769
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/770100e0266750a313b34a52a60968410fcf0769
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/20200826/8456dfbd/attachment-0001.html>
More information about the ghc-commits
mailing list