%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[PrimOp]{Primitive operations (machine-level)}
\begin{code}
-#include "HsVersions.h"
-
module PrimOp (
PrimOp(..), allThePrimOps,
tagOf_PrimOp, -- ToDo: rm
- primOp_str, -- sigh
- primOpType, isCompareOp,
- commutableOp,
+ primOpType,
+ primOpUniq, primOpOcc,
- PrimOpResultInfo(..),
- getPrimOpResultInfo,
+ commutableOp,
- primOpCanTriggerGC, primOpNeedsWrapper,
+ primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
primOpOkForSpeculation, primOpIsCheap,
- fragilePrimOp,
- HeapRequirement(..), primOpHeapReq,
+ primOpHasSideEffects,
- -- export for the Native Code Generator
- primOpInfo, -- needed for primOpNameInfo
- PrimOpInfo(..),
+ getPrimOpResultInfo, PrimOpResultInfo(..),
- pprPrimOp, showPrimOp
+ pprPrimOp
) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
import PrimRep -- most of it
import TysPrim
import TysWiredIn
-import CStrings ( identToC )
-import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
-import HeapOffs ( addOff, intOff, totHdrSize )
-import PprStyle ( codeStyle )
-import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
-import Pretty
-import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
-import TyCon ( TyCon{-instances-} )
-import Type ( getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts,
- mkForAllTys, mkFunTys, applyTyCon, typePrimRep
+import Demand ( Demand, wwLazy, wwPrim, wwStrict )
+import Var ( TyVar )
+import CallConv ( CallConv, pprCallConv )
+import PprType ( pprParendType )
+import OccName ( OccName, pprOccName, varOcc )
+import TyCon ( TyCon )
+import Type ( mkForAllTys, mkForAllTy, mkFunTy, mkFunTys,
+ mkTyConApp, typePrimRep,
+ splitAlgTyConApp, Type, isUnboxedTupleType,
+ splitAlgTyConApp_maybe
)
-import TyVar ( alphaTyVar, betaTyVar, GenTyVar{-instance Eq-} )
-import Unique ( Unique{-instance Eq-} )
-import Util ( panic#, assoc, panic{-ToDo:rm-} )
+import Unique ( Unique, mkPrimOpIdUnique )
+import Outputable
+import Util ( assoc )
+import GlaExts ( Int(..), Int#, (==#) )
\end{code}
%************************************************************************
| OrdOp | ChrOp
-- Int#-related ops:
- -- IntAbsOp unused?? ADR
+ -- IntAbsOp unused?? ADR
| IntAddOp | IntSubOp | IntMulOp | IntQuotOp
| IntRemOp | IntNegOp | IntAbsOp
+ | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
-- Word#-related ops:
- | AndOp | OrOp | NotOp
- | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
- | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
+ | WordQuotOp | WordRemOp
+ | AndOp | OrOp | NotOp | XorOp
+ | SllOp | SrlOp -- shift {left,right} {logical}
| Int2WordOp | Word2IntOp -- casts
-- Addr#-related ops:
-- Integer (and related...) ops:
-- slightly weird -- to match GMP package.
- | IntegerAddOp | IntegerSubOp | IntegerMulOp
+ | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
| IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
| IntegerCmpOp
- | Integer2IntOp | Int2IntegerOp
- | Word2IntegerOp
- | Addr2IntegerOp -- "Addr" is *always* a literal string
+ | Integer2IntOp | Integer2WordOp
+ | Int2IntegerOp | Word2IntegerOp
+ | Addr2IntegerOp
+ -- casting to/from Integer and 64-bit (un)signed quantities.
+ | IntegerToInt64Op | Int64ToIntegerOp
+ | IntegerToWord64Op | Word64ToIntegerOp
-- ?? gcd, etc?
| FloatEncodeOp | FloatDecodeOp
| WriteByteArrayOp PrimRep
| IndexByteArrayOp PrimRep
| IndexOffAddrOp PrimRep
+ | WriteOffAddrOp PrimRep
-- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
-- This is just a cheesy encoding of a bunch of ops.
- -- Note that MallocPtrRep is not included -- the only way of
- -- creating a MallocPtr is with a ccall or casm.
+ -- Note that ForeignObjRep is not included -- the only way of
+ -- creating a ForeignObj is with a ccall or casm.
+ | IndexOffForeignObjOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+ | SizeofByteArrayOp | SizeofMutableByteArrayOp
+
+ -- Mutable variables
+ | NewMutVarOp
+ | ReadMutVarOp
+ | WriteMutVarOp
+ | SameMutVarOp
+
+ -- for MVars
+ | NewMVarOp
+ | TakeMVarOp
+ | PutMVarOp
+ | SameMVarOp
+
+ -- exceptions
+ | CatchOp
+ | RaiseOp
- | NewSynchVarOp -- for MVars and IVars
- | TakeMVarOp | PutMVarOp
- | ReadIVarOp | WriteIVarOp
+ | MakeForeignObjOp
+ | WriteForeignObjOp
- | MakeStablePtrOp | DeRefStablePtrOp
+ | MkWeakOp
+ | DeRefWeakOp
+
+ | MakeStablePtrOp
+ | DeRefStablePtrOp
+ | EqStablePtrOp
\end{code}
A special ``trap-door'' to use in making calls direct to C functions:
\begin{code}
- | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
- Bool -- True <=> really a "casm"
- Bool -- True <=> might invoke Haskell GC
- [Type] -- Unboxed argument; the state-token
- -- argument will have been put *first*
- Type -- Return type; one of the "StateAnd<blah>#" types
+ | CCallOp (Either
+ FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
+ Unique) -- Right u => first argument (an Addr#) is the function pointer
+ -- (unique is used to generate a 'typedef' to cast
+ -- the function pointer if compiling the ccall# down to
+ -- .hc code - can't do this inline for tedious reasons.)
+
+ Bool -- True <=> really a "casm"
+ Bool -- True <=> might invoke Haskell GC
+ CallConv -- calling convention to use.
-- (... to be continued ... )
\end{code}
\begin{code}
-- (... continued from above ... )
- -- one to support "errorIO" (and, thereby, "error")
- | ErrorIOPrimOp
-
-- Operation to test two closure addresses for equality (yes really!)
-- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
| ReallyUnsafePtrEqualityOp
- -- three for parallel stuff
+ -- parallel stuff
| SeqOp
| ParOp
- | ForkOp
- -- two for concurrency
+ -- concurrency
+ | ForkOp
+ | KillThreadOp
| DelayOp
- | WaitOp
+ | WaitReadOp
+ | WaitWriteOp
-#ifdef GRAN
| ParGlobalOp -- named global par
| ParLocalOp -- named local par
| ParAtOp -- specifies destination of local par
+ | ParAtAbsOp -- specifies destination of local par (abs processor)
+ | ParAtRelOp -- specifies destination of local par (rel processor)
| ParAtForNowOp -- specifies initial destination of global par
| CopyableOp -- marks copyable code
| NoFollowOp -- marks non-followup expression
-#endif {-GRAN-}
\end{code}
-Deriving Ix is what we really want! ToDo
-(Chk around before deleting...)
+Used for the Ord instance
+
\begin{code}
-tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
-tagOf_PrimOp CharGeOp = ILIT( 2)
-tagOf_PrimOp CharEqOp = ILIT( 3)
-tagOf_PrimOp CharNeOp = ILIT( 4)
-tagOf_PrimOp CharLtOp = ILIT( 5)
-tagOf_PrimOp CharLeOp = ILIT( 6)
-tagOf_PrimOp IntGtOp = ILIT( 7)
-tagOf_PrimOp IntGeOp = ILIT( 8)
-tagOf_PrimOp IntEqOp = ILIT( 9)
-tagOf_PrimOp IntNeOp = ILIT( 10)
-tagOf_PrimOp IntLtOp = ILIT( 11)
-tagOf_PrimOp IntLeOp = ILIT( 12)
-tagOf_PrimOp WordGtOp = ILIT( 13)
-tagOf_PrimOp WordGeOp = ILIT( 14)
-tagOf_PrimOp WordEqOp = ILIT( 15)
-tagOf_PrimOp WordNeOp = ILIT( 16)
-tagOf_PrimOp WordLtOp = ILIT( 17)
-tagOf_PrimOp WordLeOp = ILIT( 18)
-tagOf_PrimOp AddrGtOp = ILIT( 19)
-tagOf_PrimOp AddrGeOp = ILIT( 20)
-tagOf_PrimOp AddrEqOp = ILIT( 21)
-tagOf_PrimOp AddrNeOp = ILIT( 22)
-tagOf_PrimOp AddrLtOp = ILIT( 23)
-tagOf_PrimOp AddrLeOp = ILIT( 24)
-tagOf_PrimOp FloatGtOp = ILIT( 25)
-tagOf_PrimOp FloatGeOp = ILIT( 26)
-tagOf_PrimOp FloatEqOp = ILIT( 27)
-tagOf_PrimOp FloatNeOp = ILIT( 28)
-tagOf_PrimOp FloatLtOp = ILIT( 29)
-tagOf_PrimOp FloatLeOp = ILIT( 30)
-tagOf_PrimOp DoubleGtOp = ILIT( 31)
-tagOf_PrimOp DoubleGeOp = ILIT( 32)
-tagOf_PrimOp DoubleEqOp = ILIT( 33)
-tagOf_PrimOp DoubleNeOp = ILIT( 34)
-tagOf_PrimOp DoubleLtOp = ILIT( 35)
-tagOf_PrimOp DoubleLeOp = ILIT( 36)
-tagOf_PrimOp OrdOp = ILIT( 37)
-tagOf_PrimOp ChrOp = ILIT( 38)
-tagOf_PrimOp IntAddOp = ILIT( 39)
-tagOf_PrimOp IntSubOp = ILIT( 40)
-tagOf_PrimOp IntMulOp = ILIT( 41)
-tagOf_PrimOp IntQuotOp = ILIT( 42)
-tagOf_PrimOp IntRemOp = ILIT( 44)
-tagOf_PrimOp IntNegOp = ILIT( 45)
-tagOf_PrimOp IntAbsOp = ILIT( 46)
-tagOf_PrimOp AndOp = ILIT( 47)
-tagOf_PrimOp OrOp = ILIT( 48)
-tagOf_PrimOp NotOp = ILIT( 49)
-tagOf_PrimOp SllOp = ILIT( 50)
-tagOf_PrimOp SraOp = ILIT( 51)
-tagOf_PrimOp SrlOp = ILIT( 52)
-tagOf_PrimOp ISllOp = ILIT( 53)
-tagOf_PrimOp ISraOp = ILIT( 54)
-tagOf_PrimOp ISrlOp = ILIT( 55)
-tagOf_PrimOp Int2WordOp = ILIT( 56)
-tagOf_PrimOp Word2IntOp = ILIT( 57)
-tagOf_PrimOp Int2AddrOp = ILIT( 58)
-tagOf_PrimOp Addr2IntOp = ILIT( 59)
-tagOf_PrimOp FloatAddOp = ILIT( 60)
-tagOf_PrimOp FloatSubOp = ILIT( 61)
-tagOf_PrimOp FloatMulOp = ILIT( 62)
-tagOf_PrimOp FloatDivOp = ILIT( 63)
-tagOf_PrimOp FloatNegOp = ILIT( 64)
-tagOf_PrimOp Float2IntOp = ILIT( 65)
-tagOf_PrimOp Int2FloatOp = ILIT( 66)
-tagOf_PrimOp FloatExpOp = ILIT( 67)
-tagOf_PrimOp FloatLogOp = ILIT( 68)
-tagOf_PrimOp FloatSqrtOp = ILIT( 69)
-tagOf_PrimOp FloatSinOp = ILIT( 70)
-tagOf_PrimOp FloatCosOp = ILIT( 71)
-tagOf_PrimOp FloatTanOp = ILIT( 72)
-tagOf_PrimOp FloatAsinOp = ILIT( 73)
-tagOf_PrimOp FloatAcosOp = ILIT( 74)
-tagOf_PrimOp FloatAtanOp = ILIT( 75)
-tagOf_PrimOp FloatSinhOp = ILIT( 76)
-tagOf_PrimOp FloatCoshOp = ILIT( 77)
-tagOf_PrimOp FloatTanhOp = ILIT( 78)
-tagOf_PrimOp FloatPowerOp = ILIT( 79)
-tagOf_PrimOp DoubleAddOp = ILIT( 80)
-tagOf_PrimOp DoubleSubOp = ILIT( 81)
-tagOf_PrimOp DoubleMulOp = ILIT( 82)
-tagOf_PrimOp DoubleDivOp = ILIT( 83)
-tagOf_PrimOp DoubleNegOp = ILIT( 84)
-tagOf_PrimOp Double2IntOp = ILIT( 85)
-tagOf_PrimOp Int2DoubleOp = ILIT( 86)
-tagOf_PrimOp Double2FloatOp = ILIT( 87)
-tagOf_PrimOp Float2DoubleOp = ILIT( 88)
-tagOf_PrimOp DoubleExpOp = ILIT( 89)
-tagOf_PrimOp DoubleLogOp = ILIT( 90)
-tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
-tagOf_PrimOp DoubleSinOp = ILIT( 92)
-tagOf_PrimOp DoubleCosOp = ILIT( 93)
-tagOf_PrimOp DoubleTanOp = ILIT( 94)
-tagOf_PrimOp DoubleAsinOp = ILIT( 95)
-tagOf_PrimOp DoubleAcosOp = ILIT( 96)
-tagOf_PrimOp DoubleAtanOp = ILIT( 97)
-tagOf_PrimOp DoubleSinhOp = ILIT( 98)
-tagOf_PrimOp DoubleCoshOp = ILIT( 99)
-tagOf_PrimOp DoubleTanhOp = ILIT(100)
-tagOf_PrimOp DoublePowerOp = ILIT(101)
-tagOf_PrimOp IntegerAddOp = ILIT(102)
-tagOf_PrimOp IntegerSubOp = ILIT(103)
-tagOf_PrimOp IntegerMulOp = ILIT(104)
-tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
-tagOf_PrimOp IntegerDivModOp = ILIT(106)
-tagOf_PrimOp IntegerNegOp = ILIT(107)
-tagOf_PrimOp IntegerCmpOp = ILIT(108)
-tagOf_PrimOp Integer2IntOp = ILIT(109)
-tagOf_PrimOp Int2IntegerOp = ILIT(110)
-tagOf_PrimOp Word2IntegerOp = ILIT(111)
-tagOf_PrimOp Addr2IntegerOp = ILIT(112)
-tagOf_PrimOp FloatEncodeOp = ILIT(113)
-tagOf_PrimOp FloatDecodeOp = ILIT(114)
-tagOf_PrimOp DoubleEncodeOp = ILIT(115)
-tagOf_PrimOp DoubleDecodeOp = ILIT(116)
-tagOf_PrimOp NewArrayOp = ILIT(117)
-tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
-tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
-tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
-tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
-tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
-tagOf_PrimOp SameMutableArrayOp = ILIT(123)
-tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
-tagOf_PrimOp ReadArrayOp = ILIT(125)
-tagOf_PrimOp WriteArrayOp = ILIT(126)
-tagOf_PrimOp IndexArrayOp = ILIT(127)
-tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
-tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
-tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
-tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
-tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
-tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
-tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
-tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
-tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
-tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
-tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
-tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
-tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
-tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
-tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
-tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
-tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
-tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
-tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
-tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
-tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
-tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
-tagOf_PrimOp NewSynchVarOp = ILIT(150)
-tagOf_PrimOp TakeMVarOp = ILIT(151)
-tagOf_PrimOp PutMVarOp = ILIT(152)
-tagOf_PrimOp ReadIVarOp = ILIT(153)
-tagOf_PrimOp WriteIVarOp = ILIT(154)
-tagOf_PrimOp MakeStablePtrOp = ILIT(155)
-tagOf_PrimOp DeRefStablePtrOp = ILIT(156)
-tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(157)
-tagOf_PrimOp ErrorIOPrimOp = ILIT(158)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(159)
-tagOf_PrimOp SeqOp = ILIT(160)
-tagOf_PrimOp ParOp = ILIT(161)
-tagOf_PrimOp ForkOp = ILIT(162)
-tagOf_PrimOp DelayOp = ILIT(163)
-tagOf_PrimOp WaitOp = ILIT(164)
-
-#ifdef GRAN
-tagOf_PrimOp ParGlobalOp = ILIT(165)
-tagOf_PrimOp ParLocalOp = ILIT(166)
-tagOf_PrimOp ParAtOp = ILIT(167)
-tagOf_PrimOp ParAtForNowOp = ILIT(168)
-tagOf_PrimOp CopyableOp = ILIT(169)
-tagOf_PrimOp NoFollowOp = ILIT(170)
-#endif {-GRAN-}
-
-tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
+tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
+tagOf_PrimOp CharGeOp = ILIT( 2)
+tagOf_PrimOp CharEqOp = ILIT( 3)
+tagOf_PrimOp CharNeOp = ILIT( 4)
+tagOf_PrimOp CharLtOp = ILIT( 5)
+tagOf_PrimOp CharLeOp = ILIT( 6)
+tagOf_PrimOp IntGtOp = ILIT( 7)
+tagOf_PrimOp IntGeOp = ILIT( 8)
+tagOf_PrimOp IntEqOp = ILIT( 9)
+tagOf_PrimOp IntNeOp = ILIT( 10)
+tagOf_PrimOp IntLtOp = ILIT( 11)
+tagOf_PrimOp IntLeOp = ILIT( 12)
+tagOf_PrimOp WordGtOp = ILIT( 13)
+tagOf_PrimOp WordGeOp = ILIT( 14)
+tagOf_PrimOp WordEqOp = ILIT( 15)
+tagOf_PrimOp WordNeOp = ILIT( 16)
+tagOf_PrimOp WordLtOp = ILIT( 17)
+tagOf_PrimOp WordLeOp = ILIT( 18)
+tagOf_PrimOp AddrGtOp = ILIT( 19)
+tagOf_PrimOp AddrGeOp = ILIT( 20)
+tagOf_PrimOp AddrEqOp = ILIT( 21)
+tagOf_PrimOp AddrNeOp = ILIT( 22)
+tagOf_PrimOp AddrLtOp = ILIT( 23)
+tagOf_PrimOp AddrLeOp = ILIT( 24)
+tagOf_PrimOp FloatGtOp = ILIT( 25)
+tagOf_PrimOp FloatGeOp = ILIT( 26)
+tagOf_PrimOp FloatEqOp = ILIT( 27)
+tagOf_PrimOp FloatNeOp = ILIT( 28)
+tagOf_PrimOp FloatLtOp = ILIT( 29)
+tagOf_PrimOp FloatLeOp = ILIT( 30)
+tagOf_PrimOp DoubleGtOp = ILIT( 31)
+tagOf_PrimOp DoubleGeOp = ILIT( 32)
+tagOf_PrimOp DoubleEqOp = ILIT( 33)
+tagOf_PrimOp DoubleNeOp = ILIT( 34)
+tagOf_PrimOp DoubleLtOp = ILIT( 35)
+tagOf_PrimOp DoubleLeOp = ILIT( 36)
+tagOf_PrimOp OrdOp = ILIT( 37)
+tagOf_PrimOp ChrOp = ILIT( 38)
+tagOf_PrimOp IntAddOp = ILIT( 39)
+tagOf_PrimOp IntSubOp = ILIT( 40)
+tagOf_PrimOp IntMulOp = ILIT( 41)
+tagOf_PrimOp IntQuotOp = ILIT( 42)
+tagOf_PrimOp IntRemOp = ILIT( 43)
+tagOf_PrimOp IntNegOp = ILIT( 44)
+tagOf_PrimOp IntAbsOp = ILIT( 45)
+tagOf_PrimOp WordQuotOp = ILIT( 46)
+tagOf_PrimOp WordRemOp = ILIT( 47)
+tagOf_PrimOp AndOp = ILIT( 48)
+tagOf_PrimOp OrOp = ILIT( 49)
+tagOf_PrimOp NotOp = ILIT( 50)
+tagOf_PrimOp XorOp = ILIT( 51)
+tagOf_PrimOp SllOp = ILIT( 52)
+tagOf_PrimOp SrlOp = ILIT( 53)
+tagOf_PrimOp ISllOp = ILIT( 54)
+tagOf_PrimOp ISraOp = ILIT( 55)
+tagOf_PrimOp ISrlOp = ILIT( 56)
+tagOf_PrimOp Int2WordOp = ILIT( 57)
+tagOf_PrimOp Word2IntOp = ILIT( 58)
+tagOf_PrimOp Int2AddrOp = ILIT( 59)
+tagOf_PrimOp Addr2IntOp = ILIT( 60)
+
+tagOf_PrimOp FloatAddOp = ILIT( 61)
+tagOf_PrimOp FloatSubOp = ILIT( 62)
+tagOf_PrimOp FloatMulOp = ILIT( 63)
+tagOf_PrimOp FloatDivOp = ILIT( 64)
+tagOf_PrimOp FloatNegOp = ILIT( 65)
+tagOf_PrimOp Float2IntOp = ILIT( 66)
+tagOf_PrimOp Int2FloatOp = ILIT( 67)
+tagOf_PrimOp FloatExpOp = ILIT( 68)
+tagOf_PrimOp FloatLogOp = ILIT( 69)
+tagOf_PrimOp FloatSqrtOp = ILIT( 70)
+tagOf_PrimOp FloatSinOp = ILIT( 71)
+tagOf_PrimOp FloatCosOp = ILIT( 72)
+tagOf_PrimOp FloatTanOp = ILIT( 73)
+tagOf_PrimOp FloatAsinOp = ILIT( 74)
+tagOf_PrimOp FloatAcosOp = ILIT( 75)
+tagOf_PrimOp FloatAtanOp = ILIT( 76)
+tagOf_PrimOp FloatSinhOp = ILIT( 77)
+tagOf_PrimOp FloatCoshOp = ILIT( 78)
+tagOf_PrimOp FloatTanhOp = ILIT( 79)
+tagOf_PrimOp FloatPowerOp = ILIT( 80)
+
+tagOf_PrimOp DoubleAddOp = ILIT( 81)
+tagOf_PrimOp DoubleSubOp = ILIT( 82)
+tagOf_PrimOp DoubleMulOp = ILIT( 83)
+tagOf_PrimOp DoubleDivOp = ILIT( 84)
+tagOf_PrimOp DoubleNegOp = ILIT( 85)
+tagOf_PrimOp Double2IntOp = ILIT( 86)
+tagOf_PrimOp Int2DoubleOp = ILIT( 87)
+tagOf_PrimOp Double2FloatOp = ILIT( 88)
+tagOf_PrimOp Float2DoubleOp = ILIT( 89)
+tagOf_PrimOp DoubleExpOp = ILIT( 90)
+tagOf_PrimOp DoubleLogOp = ILIT( 91)
+tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
+tagOf_PrimOp DoubleSinOp = ILIT( 93)
+tagOf_PrimOp DoubleCosOp = ILIT( 94)
+tagOf_PrimOp DoubleTanOp = ILIT( 95)
+tagOf_PrimOp DoubleAsinOp = ILIT( 96)
+tagOf_PrimOp DoubleAcosOp = ILIT( 97)
+tagOf_PrimOp DoubleAtanOp = ILIT( 98)
+tagOf_PrimOp DoubleSinhOp = ILIT( 99)
+tagOf_PrimOp DoubleCoshOp = ILIT(100)
+tagOf_PrimOp DoubleTanhOp = ILIT(101)
+tagOf_PrimOp DoublePowerOp = ILIT(102)
+
+tagOf_PrimOp IntegerAddOp = ILIT(103)
+tagOf_PrimOp IntegerSubOp = ILIT(104)
+tagOf_PrimOp IntegerMulOp = ILIT(105)
+tagOf_PrimOp IntegerGcdOp = ILIT(106)
+tagOf_PrimOp IntegerQuotRemOp = ILIT(107)
+tagOf_PrimOp IntegerDivModOp = ILIT(108)
+tagOf_PrimOp IntegerNegOp = ILIT(109)
+tagOf_PrimOp IntegerCmpOp = ILIT(110)
+tagOf_PrimOp Integer2IntOp = ILIT(111)
+tagOf_PrimOp Integer2WordOp = ILIT(112)
+tagOf_PrimOp Int2IntegerOp = ILIT(113)
+tagOf_PrimOp Word2IntegerOp = ILIT(114)
+tagOf_PrimOp Addr2IntegerOp = ILIT(115)
+tagOf_PrimOp IntegerToInt64Op = ILIT(116)
+tagOf_PrimOp Int64ToIntegerOp = ILIT(117)
+tagOf_PrimOp IntegerToWord64Op = ILIT(118)
+tagOf_PrimOp Word64ToIntegerOp = ILIT(119)
+
+tagOf_PrimOp FloatEncodeOp = ILIT(120)
+tagOf_PrimOp FloatDecodeOp = ILIT(121)
+tagOf_PrimOp DoubleEncodeOp = ILIT(122)
+tagOf_PrimOp DoubleDecodeOp = ILIT(123)
+
+tagOf_PrimOp NewArrayOp = ILIT(124)
+tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(125)
+tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(126)
+tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(127)
+tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(128)
+tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(129)
+tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(130)
+tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(131)
+tagOf_PrimOp SameMutableArrayOp = ILIT(132)
+tagOf_PrimOp SameMutableByteArrayOp = ILIT(133)
+tagOf_PrimOp ReadArrayOp = ILIT(134)
+tagOf_PrimOp WriteArrayOp = ILIT(135)
+tagOf_PrimOp IndexArrayOp = ILIT(136)
+
+tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(137)
+tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(138)
+tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(139)
+tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(140)
+tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(141)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(142)
+tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(143)
+tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(144)
+tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(145)
+
+tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(146)
+tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147)
+tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148)
+tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(149)
+tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(150)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(151)
+tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(152)
+tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(153)
+tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(154)
+
+tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(155)
+tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(156)
+tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(157)
+tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(158)
+tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(159)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(160)
+tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(161)
+tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(162)
+tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(163)
+
+tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(164)
+tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(165)
+tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(166)
+tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(167)
+tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(168)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(169)
+tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(170)
+tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(171)
+tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(172)
+tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(173)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(174)
+tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(175)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(176)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(177)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(178)
+tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(179)
+tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(180)
+tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(181)
+
+tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(182)
+tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(183)
+tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(184)
+tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(185)
+tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(186)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(187)
+tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(188)
+tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(189)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(190)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(191)
+
+tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(192)
+tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(193)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(194)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(195)
+tagOf_PrimOp NewMVarOp = ILIT(196)
+tagOf_PrimOp TakeMVarOp = ILIT(197)
+tagOf_PrimOp PutMVarOp = ILIT(198)
+tagOf_PrimOp SameMVarOp = ILIT(199)
+tagOf_PrimOp MakeForeignObjOp = ILIT(200)
+tagOf_PrimOp WriteForeignObjOp = ILIT(201)
+tagOf_PrimOp MkWeakOp = ILIT(202)
+tagOf_PrimOp DeRefWeakOp = ILIT(203)
+tagOf_PrimOp MakeStablePtrOp = ILIT(204)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(205)
+tagOf_PrimOp EqStablePtrOp = ILIT(206)
+tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(207)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(208)
+tagOf_PrimOp SeqOp = ILIT(209)
+tagOf_PrimOp ParOp = ILIT(210)
+tagOf_PrimOp ForkOp = ILIT(211)
+tagOf_PrimOp KillThreadOp = ILIT(212)
+tagOf_PrimOp DelayOp = ILIT(213)
+tagOf_PrimOp WaitReadOp = ILIT(214)
+tagOf_PrimOp WaitWriteOp = ILIT(215)
+tagOf_PrimOp ParGlobalOp = ILIT(216)
+tagOf_PrimOp ParLocalOp = ILIT(217)
+tagOf_PrimOp ParAtOp = ILIT(218)
+tagOf_PrimOp ParAtAbsOp = ILIT(219)
+tagOf_PrimOp ParAtRelOp = ILIT(220)
+tagOf_PrimOp ParAtForNowOp = ILIT(221)
+tagOf_PrimOp CopyableOp = ILIT(222)
+tagOf_PrimOp NoFollowOp = ILIT(223)
+tagOf_PrimOp NewMutVarOp = ILIT(224)
+tagOf_PrimOp ReadMutVarOp = ILIT(225)
+tagOf_PrimOp WriteMutVarOp = ILIT(226)
+tagOf_PrimOp SameMutVarOp = ILIT(227)
+tagOf_PrimOp CatchOp = ILIT(228)
+tagOf_PrimOp RaiseOp = ILIT(229)
+
+tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
+--panic# "tagOf_PrimOp: pattern-match"
instance Eq PrimOp where
- op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
+ op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
+
+instance Ord PrimOp where
+ op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
+ op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
+ op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
+ op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
+ op1 `compare` op2 | op1 < op2 = LT
+ | op1 == op2 = EQ
+ | otherwise = GT
+
+instance Outputable PrimOp where
+ ppr op = pprPrimOp op
+
+instance Show PrimOp where
+ showsPrec p op = showsPrecSDoc p (pprPrimOp op)
\end{code}
An @Enum@-derived list would be better; meanwhile... (ToDo)
IntQuotOp,
IntRemOp,
IntNegOp,
+ WordQuotOp,
+ WordRemOp,
AndOp,
OrOp,
NotOp,
+ XorOp,
SllOp,
- SraOp,
SrlOp,
ISllOp,
ISraOp,
Word2IntOp,
Int2AddrOp,
Addr2IntOp,
+
FloatAddOp,
FloatSubOp,
FloatMulOp,
IntegerAddOp,
IntegerSubOp,
IntegerMulOp,
+ IntegerGcdOp,
IntegerQuotRemOp,
IntegerDivModOp,
IntegerNegOp,
IntegerCmpOp,
Integer2IntOp,
+ Integer2WordOp,
Int2IntegerOp,
Word2IntegerOp,
Addr2IntegerOp,
+ IntegerToInt64Op,
+ Int64ToIntegerOp,
+ IntegerToWord64Op,
+ Word64ToIntegerOp,
FloatEncodeOp,
FloatDecodeOp,
DoubleEncodeOp,
NewArrayOp,
NewByteArrayOp CharRep,
NewByteArrayOp IntRep,
+ NewByteArrayOp WordRep,
NewByteArrayOp AddrRep,
NewByteArrayOp FloatRep,
NewByteArrayOp DoubleRep,
+ NewByteArrayOp StablePtrRep,
SameMutableArrayOp,
SameMutableByteArrayOp,
ReadArrayOp,
IndexArrayOp,
ReadByteArrayOp CharRep,
ReadByteArrayOp IntRep,
+ ReadByteArrayOp WordRep,
ReadByteArrayOp AddrRep,
ReadByteArrayOp FloatRep,
ReadByteArrayOp DoubleRep,
+ ReadByteArrayOp StablePtrRep,
+ ReadByteArrayOp Int64Rep,
+ ReadByteArrayOp Word64Rep,
WriteByteArrayOp CharRep,
WriteByteArrayOp IntRep,
+ WriteByteArrayOp WordRep,
WriteByteArrayOp AddrRep,
WriteByteArrayOp FloatRep,
WriteByteArrayOp DoubleRep,
+ WriteByteArrayOp StablePtrRep,
+ WriteByteArrayOp Int64Rep,
+ WriteByteArrayOp Word64Rep,
IndexByteArrayOp CharRep,
IndexByteArrayOp IntRep,
+ IndexByteArrayOp WordRep,
IndexByteArrayOp AddrRep,
IndexByteArrayOp FloatRep,
IndexByteArrayOp DoubleRep,
+ IndexByteArrayOp StablePtrRep,
+ IndexByteArrayOp Int64Rep,
+ IndexByteArrayOp Word64Rep,
+ IndexOffForeignObjOp CharRep,
+ IndexOffForeignObjOp AddrRep,
+ IndexOffForeignObjOp IntRep,
+ IndexOffForeignObjOp WordRep,
+ IndexOffForeignObjOp FloatRep,
+ IndexOffForeignObjOp DoubleRep,
+ IndexOffForeignObjOp StablePtrRep,
+ IndexOffForeignObjOp Int64Rep,
+ IndexOffForeignObjOp Word64Rep,
IndexOffAddrOp CharRep,
IndexOffAddrOp IntRep,
+ IndexOffAddrOp WordRep,
IndexOffAddrOp AddrRep,
IndexOffAddrOp FloatRep,
IndexOffAddrOp DoubleRep,
+ IndexOffAddrOp StablePtrRep,
+ IndexOffAddrOp Int64Rep,
+ IndexOffAddrOp Word64Rep,
+ WriteOffAddrOp CharRep,
+ WriteOffAddrOp IntRep,
+ WriteOffAddrOp WordRep,
+ WriteOffAddrOp AddrRep,
+ WriteOffAddrOp FloatRep,
+ WriteOffAddrOp DoubleRep,
+ WriteOffAddrOp ForeignObjRep,
+ WriteOffAddrOp StablePtrRep,
+ WriteOffAddrOp Int64Rep,
+ WriteOffAddrOp Word64Rep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
- NewSynchVarOp,
- ReadArrayOp,
+ SizeofByteArrayOp,
+ SizeofMutableByteArrayOp,
+ NewMutVarOp,
+ ReadMutVarOp,
+ WriteMutVarOp,
+ SameMutVarOp,
+ CatchOp,
+ RaiseOp,
+ NewMVarOp,
TakeMVarOp,
PutMVarOp,
- ReadIVarOp,
- WriteIVarOp,
+ SameMVarOp,
+ MakeForeignObjOp,
+ WriteForeignObjOp,
+ MkWeakOp,
+ DeRefWeakOp,
MakeStablePtrOp,
DeRefStablePtrOp,
+ EqStablePtrOp,
ReallyUnsafePtrEqualityOp,
- ErrorIOPrimOp,
-#ifdef GRAN
ParGlobalOp,
ParLocalOp,
-#endif {-GRAN-}
+ ParAtOp,
+ ParAtAbsOp,
+ ParAtRelOp,
+ ParAtForNowOp,
+ CopyableOp,
+ NoFollowOp,
SeqOp,
ParOp,
ForkOp,
+ KillThreadOp,
DelayOp,
- WaitOp
+ WaitReadOp,
+ WaitWriteOp
]
\end{code}
(slightly) more convenient to use than @TyCons@.
\begin{code}
data PrimOpInfo
- = Dyadic FAST_STRING -- string :: T -> T -> T
+ = Dyadic OccName -- string :: T -> T -> T
Type
- | Monadic FAST_STRING -- string :: T -> T
- Type
- | Compare FAST_STRING -- string :: T -> T -> Bool
- Type
- | Coercing FAST_STRING -- string :: T1 -> T2
+ | Monadic OccName -- string :: T -> T
Type
+ | Compare OccName -- string :: T -> T -> Bool
Type
- | PrimResult FAST_STRING
- [TyVar] [Type] TyCon PrimRep [Type]
- -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
- -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
- -- D# is a primitive type constructor.
- -- (the kind is the same info as D#, in another convenient form)
+ | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
+ [TyVar]
+ [Type]
+ Type
- | AlgResult FAST_STRING
- [TyVar] [Type] TyCon [Type]
- -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
- -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
-
--- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
+mkDyadic str ty = Dyadic (varOcc str) ty
+mkMonadic str ty = Monadic (varOcc str) ty
+mkCompare str ty = Compare (varOcc str) ty
+mkGenPrimOp str tvs tys ty = GenPrimOp (varOcc str) tvs tys ty
\end{code}
Utility bits:
= [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
intPrimTy]
-integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
+unboxedPair = mkUnboxedTupleTy 2
+unboxedTriple = mkUnboxedTupleTy 3
+unboxedQuadruple = mkUnboxedTupleTy 4
+unboxedSexTuple = mkUnboxedTupleTy 6
+
+integerMonadic name = mkGenPrimOp name [] one_Integer_ty
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
+integerDyadic name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
-integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
+integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy,
+ intPrimTy, intPrimTy, byteArrayPrimTy])
-integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
+integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
\end{code}
-@primOpInfo@ gives all essential information (from which everything
-else, notably a type, can be constructed) for each @PrimOp@.
+%************************************************************************
+%* *
+\subsubsection{Strictness}
+%* *
+%************************************************************************
+
+Not all primops are strict!
\begin{code}
-primOpInfo :: PrimOp -> PrimOpInfo
+primOpStrictness :: PrimOp -> ([Demand], Bool)
+ -- See IdInfo.StrictnessInfo for discussion of what the results
+ -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,
+ -- the list of demands may be infinite!
+ -- Use only the ones you ned.
+
+primOpStrictness SeqOp = ([wwLazy], False)
+primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
+primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
+primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
+primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
+primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
+primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
+primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
+primOpStrictness other = (repeat wwPrim, False)
\end{code}
-There's plenty of this stuff!
-
%************************************************************************
%* *
\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
%* *
%************************************************************************
+@primOpInfo@ gives all essential information (from which everything
+else, notably a type, can be constructed) for each @PrimOp@.
+
\begin{code}
-primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
-primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
-primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
-primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
-primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
-primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
-
-primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
-primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
-primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
-primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
-primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
-primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
-
-primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
-primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
-primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
-primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
-primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
-primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
-
-primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
-primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
-primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
-primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
-primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
-primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
-
-primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
-primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
-primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
-primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
-primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
-primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
-
-primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
-primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
-primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
-primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
-primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
-primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
+primOpInfo :: PrimOp -> PrimOpInfo
+\end{code}
+
+There's plenty of this stuff!
+
+\begin{code}
+primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
+primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
+primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
+primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
+primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
+primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
+
+primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
+primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
+primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
+primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
+primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
+primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
+
+primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
+primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
+primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
+primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
+primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
+primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
+
+primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
+primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
+primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
+primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
+primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
+primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
+
+primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
+primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
+primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
+primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
+primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
+primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
+
+primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
+primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
+primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
+primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
+primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
+primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
+
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
-primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
+primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
+primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
-primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
-primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
-primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
-primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
-
-primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
+primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
+primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
+primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
+primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
+primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
+
+primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
+primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
\end{code}
%************************************************************************
A @Word#@ is an unsigned @Int#@.
\begin{code}
-primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
-primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
-primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
+primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
+primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
+
+primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
+primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
+primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
+primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
primOpInfo SllOp
- = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
-primOpInfo SraOp
- = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
+ = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
primOpInfo SrlOp
- = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
+ = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
primOpInfo ISllOp
- = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
primOpInfo ISraOp
- = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
primOpInfo ISrlOp
- = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
-primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
-primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
+primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
+primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
-primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
+primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
+primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
\end{code}
+
%************************************************************************
%* *
\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
similar).
\begin{code}
-primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
-primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
-primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
-primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
-primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
-
-primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
-primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
-
-primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
-primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
-primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
-primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
-primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
-primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
-primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
-primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
-primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
-primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
-primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
-primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
-primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
+primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
+primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
+primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
+primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
+primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
+
+primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
+primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
+
+primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
+primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
+primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
+primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
+primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
+primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
+primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
+primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
+primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
+primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
+primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
+primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
+primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
\end{code}
%************************************************************************
similar).
\begin{code}
-primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
-primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
-primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
-primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
-primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
-
-primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
-primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
-
-primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
-primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
-
-primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
-primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
-primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
-primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
-primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
-primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
-primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
-primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
-primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
-primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
-primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
-primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
-primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
+primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
+primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
+primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
+primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
+primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
+
+primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
+primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
+
+primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
+primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
+
+primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
+primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
+primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
+primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
+primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
+primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
+primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
+primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
+primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
+primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
+primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
+primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
+primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
\end{code}
%************************************************************************
primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
+primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
primOpInfo Integer2IntOp
- = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
+
+primOpInfo Integer2WordOp
+ = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
primOpInfo Int2IntegerOp
- = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
+ = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
primOpInfo Word2IntegerOp
- = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
+ = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
primOpInfo Addr2IntegerOp
- = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
+ = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+
+primOpInfo IntegerToInt64Op
+ = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
+
+primOpInfo Int64ToIntegerOp
+ = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+
+primOpInfo Word64ToIntegerOp
+ = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+
+primOpInfo IntegerToWord64Op
+ = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
\end{code}
Encoding and decoding of floating-point numbers is sorta
\begin{code}
primOpInfo FloatEncodeOp
- = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
- floatPrimTyCon FloatRep []
+ = mkGenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
primOpInfo DoubleEncodeOp
- = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
- doublePrimTyCon DoubleRep []
+ = mkGenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
primOpInfo FloatDecodeOp
- = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
-
+ = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
+ (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
primOpInfo DoubleDecodeOp
- = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
+ = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
+ (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
\end{code}
%************************************************************************
\begin{code}
primOpInfo NewArrayOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
} in
- AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
- stateAndMutableArrayPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
+ [intPrimTy, elt, state]
+ (unboxedPair [state, mkMutableArrayPrimTy s elt])
primOpInfo (NewByteArrayOp kind)
= let
s = alphaTy; s_tv = alphaTyVar
- (str, _, prim_tycon) = getPrimRepInfo kind
-
- op_str = _PK_ ("new" ++ str ++ "Array#")
+ op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
+ state = mkStatePrimTy s
in
- AlgResult op_str [s_tv]
- [intPrimTy, mkStatePrimTy s]
- stateAndMutableByteArrayPrimTyCon [s]
+ mkGenPrimOp op_str [s_tv]
+ [intPrimTy, state]
+ (unboxedPair [state, mkMutableByteArrayPrimTy s])
---------------------------------------------------------------------------
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
mut_arr_ty = mkMutableArrayPrimTy s elt
} in
- AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
- boolTyCon []
+ mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
+ boolTy
primOpInfo SameMutableByteArrayOp
= let {
s = alphaTy; s_tv = alphaTyVar;
mut_arr_ty = mkMutableByteArrayPrimTy s
} in
- AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
- boolTyCon []
+ mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
+ boolTy
---------------------------------------------------------------------------
-- Primitive arrays of Haskell pointers:
primOpInfo ReadArrayOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
} in
- AlgResult SLIT("readArray#") [s_tv, elt_tv]
- [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
- stateAndPtrPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
+ [mkMutableArrayPrimTy s elt, intPrimTy, state]
+ (unboxedPair [state, elt])
primOpInfo WriteArrayOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
} in
- PrimResult SLIT("writeArray#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
[mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
- statePrimTyCon VoidRep [s]
+ (mkStatePrimTy s)
primOpInfo IndexArrayOp
= let { elt = alphaTy; elt_tv = alphaTyVar } in
- AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
- liftTyCon [elt]
+ mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
+ (unboxedPair [realWorldStatePrimTy, elt])
---------------------------------------------------------------------------
-- Primitive arrays full of unboxed bytes:
= let
s = alphaTy; s_tv = alphaTyVar
- (str, _, prim_tycon) = getPrimRepInfo kind
+ op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
+ relevant_type = assoc "primOpInfo{ReadByteArrayOp}" tbl kind
+ state = mkStatePrimTy s
- op_str = _PK_ ("read" ++ str ++ "Array#")
- relevant_tycon = assoc "primOpInfo" tbl kind
+ tvs
+ | kind == StablePtrRep = [s_tv, betaTyVar]
+ | otherwise = [s_tv]
in
- AlgResult op_str [s_tv]
- [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
- relevant_tycon [s]
+ mkGenPrimOp op_str tvs
+ [mkMutableByteArrayPrimTy s, intPrimTy, state]
+ (unboxedPair [state, relevant_type])
where
- tbl = [ (CharRep, stateAndCharPrimTyCon),
- (IntRep, stateAndIntPrimTyCon),
- (AddrRep, stateAndAddrPrimTyCon),
- (FloatRep, stateAndFloatPrimTyCon),
- (DoubleRep, stateAndDoublePrimTyCon) ]
+ tbl = [ (CharRep, charPrimTy),
+ (IntRep, intPrimTy),
+ (WordRep, wordPrimTy),
+ (AddrRep, addrPrimTy),
+ (FloatRep, floatPrimTy),
+ (StablePtrRep, mkStablePtrPrimTy betaTy),
+ (DoubleRep, doublePrimTy) ]
-- How come there's no Word byte arrays? ADR
primOpInfo (WriteByteArrayOp kind)
= let
s = alphaTy; s_tv = alphaTyVar
+ op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
+ prim_ty = mkTyConApp (primRepTyCon kind) []
+
+ (the_prim_ty, tvs)
+ | kind == StablePtrRep = (mkStablePtrPrimTy betaTy, [s_tv, betaTyVar])
+ | otherwise = (prim_ty, [s_tv])
- (str, prim_ty, _) = getPrimRepInfo kind
- op_str = _PK_ ("write" ++ str ++ "Array#")
in
- -- NB: *Prim*Result --
- PrimResult op_str [s_tv]
- [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
- statePrimTyCon VoidRep [s]
+ mkGenPrimOp op_str tvs
+ [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
+ (mkStatePrimTy s)
primOpInfo (IndexByteArrayOp kind)
= let
- (str, _, prim_tycon) = getPrimRepInfo kind
- op_str = _PK_ ("index" ++ str ++ "Array#")
+ op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
+
+ (prim_tycon_args, tvs)
+ | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
+ | otherwise = ([],[])
in
- -- NB: *Prim*Result --
- PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
+ mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy]
+ (mkTyConApp (primRepTyCon kind) prim_tycon_args)
+
+primOpInfo (IndexOffForeignObjOp kind)
+ = let
+ op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
+
+ (prim_tycon_args, tvs)
+ | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
+ | otherwise = ([], [])
+ in
+ mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy]
+ (mkTyConApp (primRepTyCon kind) prim_tycon_args)
primOpInfo (IndexOffAddrOp kind)
= let
- (str, _, prim_tycon) = getPrimRepInfo kind
- op_str = _PK_ ("index" ++ str ++ "OffAddr#")
+ op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
+
+ (prim_tycon_args, tvs)
+ | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
+ | otherwise = ([], [])
+ in
+ mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy]
+ (mkTyConApp (primRepTyCon kind) prim_tycon_args)
+
+primOpInfo (WriteOffAddrOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+ op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
+ prim_ty = mkTyConApp (primRepTyCon kind) []
in
- PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
+ mkGenPrimOp op_str [s_tv]
+ [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
+ (mkStatePrimTy s)
---------------------------------------------------------------------------
primOpInfo UnsafeFreezeArrayOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
} in
- AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
- [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
- stateAndArrayPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
+ [mkMutableArrayPrimTy s elt, state]
+ (unboxedPair [state, mkArrayPrimTy elt])
primOpInfo UnsafeFreezeByteArrayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
+ [mkMutableByteArrayPrimTy s, state]
+ (unboxedPair [state, byteArrayPrimTy])
+
+---------------------------------------------------------------------------
+primOpInfo SizeofByteArrayOp
+ = mkGenPrimOp
+ SLIT("sizeofByteArray#") []
+ [byteArrayPrimTy]
+ intPrimTy
+
+primOpInfo SizeofMutableByteArrayOp
= let { s = alphaTy; s_tv = alphaTyVar } in
- AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
- [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
- stateAndByteArrayPrimTyCon [s]
+ mkGenPrimOp
+ SLIT("sizeofMutableByteArray#") [s_tv]
+ [mkMutableByteArrayPrimTy s]
+ intPrimTy
\end{code}
+
%************************************************************************
%* *
-\subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
+\subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
%* *
%************************************************************************
\begin{code}
-primOpInfo NewSynchVarOp
+primOpInfo NewMutVarOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
} in
- AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
- stateAndSynchVarPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
+ [elt, state]
+ (unboxedPair [state, mkMutVarPrimTy s elt])
-primOpInfo TakeMVarOp
+primOpInfo ReadMutVarOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
} in
- AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
- [mkSynchVarPrimTy s elt, mkStatePrimTy s]
- stateAndPtrPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
+ [mkMutVarPrimTy s elt, state]
+ (unboxedPair [state, elt])
-primOpInfo PutMVarOp
+
+primOpInfo WriteMutVarOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
} in
- AlgResult SLIT("putMVar#") [s_tv, elt_tv]
- [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
- statePrimTyCon [s]
+ mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
+ [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
+ (mkStatePrimTy s)
-primOpInfo ReadIVarOp
+primOpInfo SameMutVarOp
= let {
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ mut_var_ty = mkMutVarPrimTy s elt
} in
- AlgResult SLIT("readIVar#") [s_tv, elt_tv]
- [mkSynchVarPrimTy s elt, mkStatePrimTy s]
- stateAndPtrPrimTyCon [s, elt]
+ mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
+ boolTy
+\end{code}
-primOpInfo WriteIVarOp
- = let {
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
+%* *
+%************************************************************************
+
+catch :: IO a -> (IOError -> IO a) -> IO a
+catch :: a -> (b -> a) -> a
+
+\begin{code}
+primOpInfo CatchOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar;
+ b = betaTy; b_tv = betaTyVar;
+ in
+ mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
+
+primOpInfo RaiseOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar;
+ b = betaTy; b_tv = betaTyVar;
+ in
+ mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo NewMVarOp
+ = let
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
- } in
- AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
- [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
- statePrimTyCon [s]
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
+ (unboxedPair [state, mkMVarPrimTy s elt])
+
+primOpInfo TakeMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, state]
+ (unboxedPair [state, elt])
+primOpInfo PutMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ in
+ mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
+ (mkStatePrimTy s)
+
+primOpInfo SameMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ mvar_ty = mkMVarPrimTy s elt
+ in
+ mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
\end{code}
%************************************************************************
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- PrimResult SLIT("delay#") [s_tv]
- [intPrimTy, mkStatePrimTy s]
- statePrimTyCon VoidRep [s]
+ mkGenPrimOp SLIT("delay#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
-primOpInfo WaitOp
+primOpInfo WaitReadOp
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- PrimResult SLIT("wait#") [s_tv]
- [intPrimTy, mkStatePrimTy s]
- statePrimTyCon VoidRep [s]
+ mkGenPrimOp SLIT("waitRead#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+primOpInfo WaitWriteOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("waitWrite#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\end{code}
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
+%* *
+%************************************************************************
+
+\begin{code}
+-- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+primOpInfo ForkOp
+ = mkGenPrimOp SLIT("fork#") [alphaTyVar]
+ [alphaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
+
+-- killThread# :: ThreadId# -> State# RealWorld -> State# RealWorld
+primOpInfo KillThreadOp
+ = mkGenPrimOp SLIT("killThread#") []
+ [threadIdPrimTy, realWorldStatePrimTy]
+ realWorldStatePrimTy
+\end{code}
+
+************************************************************************
+%* *
+\subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo MakeForeignObjOp
+ = mkGenPrimOp SLIT("makeForeignObj#") []
+ [addrPrimTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
+
+primOpInfo WriteForeignObjOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
+ [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+\end{code}
+
+************************************************************************
+%* *
+\subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
+%* *
+%************************************************************************
+
+A @Weak@ Pointer is created by the @mkWeak#@ primitive:
+
+ mkWeak# :: k -> v -> f -> State# RealWorld
+ -> (# State# RealWorld, Weak# v #)
+
+In practice, you'll use the higher-level
+
+ data Weak v = Weak# v
+ mkWeak :: k -> v -> IO () -> IO (Weak v)
+
+\begin{code}
+primOpInfo MkWeakOp
+ = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
+ [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
+\end{code}
+
+The following operation dereferences a weak pointer. The weak pointer
+may have been finalised, so the operation returns a result code which
+must be inspected before looking at the dereferenced value.
+
+ deRefWeak# :: Weak# v -> State# RealWorld ->
+ (# State# RealWorld, v, Int# #)
+
+Only look at v if the Int# returned is /= 0 !!
+
+The higher-level op is
+
+ deRefWeak :: Weak v -> IO (Maybe v)
+
+\begin{code}
+primOpInfo DeRefWeakOp
+ = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
+ [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
+ (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
+\end{code}
%************************************************************************
%* *
state-interface document).
\begin{verbatim}
-makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
+makeStablePtr# :: a -> State# _RealWorld -> (# State# _RealWorld, a #)
freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
-deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
+deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> (# State# _RealWorld, a #)
+eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
\end{verbatim}
It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
\begin{code}
primOpInfo MakeStablePtrOp
- = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
+ = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
[alphaTy, realWorldStatePrimTy]
- stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
+ (unboxedPair [realWorldStatePrimTy,
+ mkTyConApp stablePtrPrimTyCon [alphaTy]])
primOpInfo DeRefStablePtrOp
- = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
+ = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
[mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
- stateAndPtrPrimTyCon [realWorldTy, alphaTy]
+ (unboxedPair [realWorldStatePrimTy, alphaTy])
+
+primOpInfo EqStablePtrOp
+ = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
+ [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
+ intPrimTy
\end{code}
%************************************************************************
\begin{code}
primOpInfo ReallyUnsafePtrEqualityOp
- = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
- [alphaTy, alphaTy] intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
+ [alphaTy, alphaTy] intPrimTy
\end{code}
%************************************************************************
\begin{code}
primOpInfo SeqOp -- seq# :: a -> Int#
- = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
+ = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
primOpInfo ParOp -- par# :: a -> Int#
- = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
-
-primOpInfo ForkOp -- fork# :: a -> Int#
- = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
-
+ = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
\end{code}
\begin{code}
-#ifdef GRAN
+-- HWL: The first 4 Int# in all par... annotations denote:
+-- name, granularity info, size of result, degree of parallelism
+-- Same structure as _seq_ i.e. returns Int#
-primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b
- = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
+primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
+ = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b
- = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
+primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
+ = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c
- = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
+primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
+ = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
-primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c
- = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
+primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
+ = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo CopyableOp -- copyable# :: a -> a
- = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
+primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
+ = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo NoFollowOp -- noFollow# :: a -> a
- = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
-
-#endif {-GRAN-}
-\end{code}
+primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
+ = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
-%************************************************************************
-%* *
-\subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
-%* *
-%************************************************************************
+primOpInfo CopyableOp -- copyable# :: a -> a
+ = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
-\begin{code}
-primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
- = PrimResult SLIT("errorIO#") []
- [mkPrimIoTy unitTy]
- statePrimTyCon VoidRep [realWorldTy]
+primOpInfo NoFollowOp -- noFollow# :: a -> a
+ = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo (CCallOp _ _ _ arg_tys result_ty)
- = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
- where
- (result_tycon, tys_applied, _) = _trace "PrimOp.getAppDataTyConExpandingDicts" $
- getAppDataTyConExpandingDicts result_ty
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
-%* *
-%************************************************************************
-
-The primitive-array-creation @PrimOps@ and {\em most} of those to do
-with @Integers@ can trigger GC. Here we describe the heap requirements
-of the various @PrimOps@. For most, no heap is required. For a few,
-a fixed amount of heap is required, and the needs of the @PrimOp@ can
-be combined with the rest of the heap usage in the basic block. For an
-unfortunate few, some unknown amount of heap is required (these are the
-ops which can trigger GC).
+primOpInfo (CCallOp _ _ _ _)
+ = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
-\begin{code}
-data HeapRequirement
- = NoHeapRequired
- | FixedHeapRequired HeapOffset
- | VariableHeapRequired
-
-primOpHeapReq :: PrimOp -> HeapRequirement
-
-primOpHeapReq NewArrayOp = VariableHeapRequired
-primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
-
-primOpHeapReq IntegerAddOp = VariableHeapRequired
-primOpHeapReq IntegerSubOp = VariableHeapRequired
-primOpHeapReq IntegerMulOp = VariableHeapRequired
-primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
-primOpHeapReq IntegerDivModOp = VariableHeapRequired
-primOpHeapReq IntegerNegOp = VariableHeapRequired
-primOpHeapReq Int2IntegerOp = FixedHeapRequired
- (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
- (intOff mIN_MP_INT_SIZE))
-primOpHeapReq Word2IntegerOp = FixedHeapRequired
- (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
- (intOff mIN_MP_INT_SIZE))
-primOpHeapReq Addr2IntegerOp = VariableHeapRequired
-primOpHeapReq FloatDecodeOp = FixedHeapRequired
- (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
- (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
- (intOff mIN_MP_INT_SIZE)))
-primOpHeapReq DoubleDecodeOp = FixedHeapRequired
- (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
- (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
- (intOff mIN_MP_INT_SIZE)))
-
--- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
--- or if it returns a MallocPtr.
-
-primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
-primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty)
- = if returnsMallocPtr
- then VariableHeapRequired
- else NoHeapRequired
+{-
+primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
+ = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
where
- returnsMallocPtr
- = case (maybeAppDataTyConExpandingDicts return_ty) of
- Nothing -> False
- Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon
-
--- this occasionally has to expand the Stable Pointer table
-primOpHeapReq MakeStablePtrOp = VariableHeapRequired
-
--- These four only need heap space with the native code generator
--- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
-
-primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
-primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
-primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
-primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
-
--- a NewSynchVarOp creates a three-word mutuple in the heap.
-primOpHeapReq NewSynchVarOp = FixedHeapRequired
- (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
-
--- Sparking ops no longer allocate any heap; however, _fork_ may
--- require a context switch to clear space in the required thread
--- pool, and that requires liveness information.
-
-primOpHeapReq ParOp = NoHeapRequired
-primOpHeapReq ForkOp = VariableHeapRequired
-
--- A SeqOp requires unknown space to evaluate its argument
-primOpHeapReq SeqOp = VariableHeapRequired
-
-#ifdef GRAN
-
--- a ParGlobalOp creates a single 4-tuple in the heap. ToDo: verify this!
-primOpHeapReq ParGlobalOp = trace "primOpHeapReq:ParGlobalOp:verify!" (
- FixedHeapRequired
- (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
- )
-
--- a ParLocalOp creates a single 4-tuple in the heap. ToDo: verify this!
-primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" (
- FixedHeapRequired
- (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
- )
-
--- ToDo: parAt, parAtForNow, copyable, noFollow !! (HWL)
-#endif {-GRAN-}
-
-primOpHeapReq other_op = NoHeapRequired
+ (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
+-}
+#ifdef DEBUG
+primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
+#endif
\end{code}
-Primops which can trigger GC have to be called carefully.
-In particular, their arguments are guaranteed to be in registers,
-and a liveness mask tells which regs are live.
+Some PrimOps need to be called out-of-line because they either need to
+perform a heap check or they block.
\begin{code}
-primOpCanTriggerGC op
+primOpOutOfLine op
= case op of
- TakeMVarOp -> True
- ReadIVarOp -> True
- DelayOp -> True
- WaitOp -> True
- _ ->
- case primOpHeapReq op of
- VariableHeapRequired -> True
- _ -> False
+ TakeMVarOp -> True
+ PutMVarOp -> True
+ DelayOp -> True
+ WaitReadOp -> True
+ WaitWriteOp -> True
+ CatchOp -> True
+ RaiseOp -> True
+ NewArrayOp -> True
+ NewByteArrayOp _ -> True
+ IntegerAddOp -> True
+ IntegerSubOp -> True
+ IntegerMulOp -> True
+ IntegerGcdOp -> True
+ IntegerQuotRemOp -> True
+ IntegerDivModOp -> True
+ Int2IntegerOp -> True
+ Word2IntegerOp -> True
+ Addr2IntegerOp -> True
+ Word64ToIntegerOp -> True
+ Int64ToIntegerOp -> True
+ FloatDecodeOp -> True
+ DoubleDecodeOp -> True
+ MkWeakOp -> True
+ DeRefWeakOp -> True
+ MakeForeignObjOp -> True
+ MakeStablePtrOp -> True
+ NewMutVarOp -> True
+ NewMVarOp -> True
+ ForkOp -> True
+ KillThreadOp -> True
+ CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
+ _ -> False
\end{code}
Sometimes we may choose to execute a PrimOp even though it isn't
See also @primOpIsCheap@ (below).
-There should be no worries about side effects; that's all taken care
-of by data dependencies.
+PrimOps that have side effects also should not be executed speculatively
+or by data dependencies.
\begin{code}
primOpOkForSpeculation :: PrimOp -> Bool
+primOpOkForSpeculation op
+ = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
+\end{code}
+@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
+WARNING), we just borrow some other predicates for a
+what-should-be-good-enough test. "Cheap" means willing to call it more
+than once. Evaluation order is unaffected.
+
+\begin{code}
+primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
+\end{code}
+
+\begin{code}
+primOpCanFail :: PrimOp -> Bool
-- Int.
-primOpOkForSpeculation IntQuotOp = False -- Divide by zero
-primOpOkForSpeculation IntRemOp = False -- Divide by zero
+primOpCanFail IntQuotOp = True -- Divide by zero
+primOpCanFail IntRemOp = True -- Divide by zero
-- Integer
-primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
-primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
+primOpCanFail IntegerQuotRemOp = True -- Divide by zero
+primOpCanFail IntegerDivModOp = True -- Divide by zero
-- Float. ToDo: tan? tanh?
-primOpOkForSpeculation FloatDivOp = False -- Divide by zero
-primOpOkForSpeculation FloatLogOp = False -- Log of zero
-primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
-primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
+primOpCanFail FloatDivOp = True -- Divide by zero
+primOpCanFail FloatLogOp = True -- Log of zero
+primOpCanFail FloatAsinOp = True -- Arg out of domain
+primOpCanFail FloatAcosOp = True -- Arg out of domain
-- Double. ToDo: tan? tanh?
-primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
-primOpOkForSpeculation DoubleLogOp = False -- Log of zero
-primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
-primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
+primOpCanFail DoubleDivOp = True -- Divide by zero
+primOpCanFail DoubleLogOp = True -- Log of zero
+primOpCanFail DoubleAsinOp = True -- Arg out of domain
+primOpCanFail DoubleAcosOp = True -- Arg out of domain
--- CCall
-primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
-
--- errorIO#
-primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
-
--- parallel
-primOpOkForSpeculation ParOp = False -- Could be expensive!
-primOpOkForSpeculation ForkOp = False -- Likewise
-primOpOkForSpeculation SeqOp = False -- Likewise
-
-#ifdef GRAN
-primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
-primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
-#endif {-GRAN-}
-
--- The default is "yes it's ok for speculation"
-primOpOkForSpeculation other_op = True
-\end{code}
-
-@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
-WARNING), we just borrow some other predicates for a
-what-should-be-good-enough test.
-\begin{code}
-primOpIsCheap op
- = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
+primOpCanFail other_op = False
\end{code}
And some primops have side-effects and so, for example, must not be
duplicated.
\begin{code}
-fragilePrimOp :: PrimOp -> Bool
-
-fragilePrimOp ParOp = True
-fragilePrimOp ForkOp = True
-fragilePrimOp SeqOp = True
-fragilePrimOp MakeStablePtrOp = True
-fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
-
-#ifdef GRAN
-fragilePrimOp ParGlobalOp = True
-fragilePrimOp ParLocalOp = True
-fragilePrimOp CopyableOp = trace "fragilePrimOp:CopyableOp" True -- Possibly not. ASP
-fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly not. ASP
-#endif {-GRAN-}
-
-fragilePrimOp other = False
+primOpHasSideEffects :: PrimOp -> Bool
+
+primOpHasSideEffects TakeMVarOp = True
+primOpHasSideEffects DelayOp = True
+primOpHasSideEffects WaitReadOp = True
+primOpHasSideEffects WaitWriteOp = True
+
+primOpHasSideEffects ParOp = True
+primOpHasSideEffects ForkOp = True
+primOpHasSideEffects KillThreadOp = True
+primOpHasSideEffects SeqOp = True
+
+primOpHasSideEffects MakeForeignObjOp = True
+primOpHasSideEffects WriteForeignObjOp = True
+primOpHasSideEffects MkWeakOp = True
+primOpHasSideEffects DeRefWeakOp = True
+primOpHasSideEffects MakeStablePtrOp = True
+primOpHasSideEffects EqStablePtrOp = True -- SOF
+primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
+
+primOpHasSideEffects ParGlobalOp = True
+primOpHasSideEffects ParLocalOp = True
+primOpHasSideEffects ParAtOp = True
+primOpHasSideEffects ParAtAbsOp = True
+primOpHasSideEffects ParAtRelOp = True
+primOpHasSideEffects ParAtForNowOp = True
+primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
+primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
+
+-- CCall
+primOpHasSideEffects (CCallOp _ _ _ _) = True
+
+primOpHasSideEffects other = False
\end{code}
-Primitive operations that perform calls need wrappers to save any live variables
-that are stored in caller-saves registers
+Inline primitive operations that perform calls need wrappers to save
+any live variables that are stored in caller-saves registers.
\begin{code}
primOpNeedsWrapper :: PrimOp -> Bool
-primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
+primOpNeedsWrapper (CCallOp _ _ _ _) = True
-primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
-primOpNeedsWrapper (NewByteArrayOp _) = True
-
-primOpNeedsWrapper IntegerAddOp = True
-primOpNeedsWrapper IntegerSubOp = True
-primOpNeedsWrapper IntegerMulOp = True
-primOpNeedsWrapper IntegerQuotRemOp = True
-primOpNeedsWrapper IntegerDivModOp = True
-primOpNeedsWrapper IntegerNegOp = True
-primOpNeedsWrapper IntegerCmpOp = True
primOpNeedsWrapper Integer2IntOp = True
-primOpNeedsWrapper Int2IntegerOp = True
-primOpNeedsWrapper Word2IntegerOp = True
-primOpNeedsWrapper Addr2IntegerOp = True
+primOpNeedsWrapper Integer2WordOp = True
+primOpNeedsWrapper IntegerCmpOp = True
primOpNeedsWrapper FloatExpOp = True
primOpNeedsWrapper FloatLogOp = True
primOpNeedsWrapper FloatCoshOp = True
primOpNeedsWrapper FloatTanhOp = True
primOpNeedsWrapper FloatPowerOp = True
-primOpNeedsWrapper FloatEncodeOp = True
-primOpNeedsWrapper FloatDecodeOp = True
+primOpNeedsWrapper FloatEncodeOp = True
primOpNeedsWrapper DoubleExpOp = True
primOpNeedsWrapper DoubleLogOp = True
primOpNeedsWrapper DoubleCoshOp = True
primOpNeedsWrapper DoubleTanhOp = True
primOpNeedsWrapper DoublePowerOp = True
-primOpNeedsWrapper DoubleEncodeOp = True
-primOpNeedsWrapper DoubleDecodeOp = True
+primOpNeedsWrapper DoubleEncodeOp = True
primOpNeedsWrapper MakeStablePtrOp = True
primOpNeedsWrapper DeRefStablePtrOp = True
-primOpNeedsWrapper TakeMVarOp = True
-primOpNeedsWrapper PutMVarOp = True
-primOpNeedsWrapper ReadIVarOp = True
-
primOpNeedsWrapper DelayOp = True
-primOpNeedsWrapper WaitOp = True
+primOpNeedsWrapper WaitReadOp = True
+primOpNeedsWrapper WaitWriteOp = True
primOpNeedsWrapper other_op = False
\end{code}
\begin{code}
-primOp_str op
+primOpOcc op
= case (primOpInfo op) of
- Dyadic str _ -> str
- Monadic str _ -> str
- Compare str _ -> str
- Coercing str _ _ -> str
- PrimResult str _ _ _ _ _ -> str
- AlgResult str _ _ _ _ -> str
+ Dyadic occ _ -> occ
+ Monadic occ _ -> occ
+ Compare occ _ -> occ
+ GenPrimOp occ _ _ _ -> occ
\end{code}
-@primOpType@ duplicates some work of @primOpId@, but since we
-grab types pretty often...
\begin{code}
-primOpType :: PrimOp -> Type
+primOpUniq :: PrimOp -> Unique
+primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
+primOpType :: PrimOp -> Type
primOpType op
= case (primOpInfo op) of
- Dyadic str ty -> dyadic_fun_ty ty
- Monadic str ty -> monadic_fun_ty ty
- Compare str ty -> compare_fun_ty ty
- Coercing str ty1 ty2 -> mkFunTys [ty1] ty2
-
- PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
+ Dyadic occ ty -> dyadic_fun_ty ty
+ Monadic occ ty -> monadic_fun_ty ty
+ Compare occ ty -> compare_fun_ty ty
- AlgResult str tyvars arg_tys tycon res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
+ GenPrimOp occ tyvars arg_tys res_ty ->
+ mkForAllTys tyvars (mkFunTys arg_tys res_ty)
\end{code}
\begin{code}
= ReturnsPrim PrimRep
| ReturnsAlg TyCon
--- ToDo: Deal with specialised PrimOps
--- Will need to return specialised tycon and data constructors
+-- Some PrimOps need not return a manifest primitive or algebraic value
+-- (i.e. they might return a polymorphic value). These PrimOps *must*
+-- be out of line, or the code generator won't work.
getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
Monadic _ ty -> ReturnsPrim (typePrimRep ty)
Compare _ ty -> ReturnsAlg boolTyCon
- Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
- PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
- AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
+ GenPrimOp _ _ _ ty ->
+ let rep = typePrimRep ty in
+ case rep of
+ PtrRep -> case splitAlgTyConApp_maybe ty of
+ Nothing -> panic "getPrimOpResultInfo"
+ Just (tc,_,_) -> ReturnsAlg tc
+ other -> ReturnsPrim other
isCompareOp :: PrimOp -> Bool
commutableOp IntMulOp = True
commutableOp AndOp = True
commutableOp OrOp = True
+commutableOp XorOp = True
commutableOp IntEqOp = True
commutableOp IntNeOp = True
commutableOp IntegerAddOp = True
commutableOp IntegerMulOp = True
+commutableOp IntegerGcdOp = True
commutableOp FloatAddOp = True
commutableOp FloatMulOp = True
commutableOp FloatEqOp = True
Utils:
\begin{code}
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
-monadic_fun_ty ty = mkFunTys [ty] ty
+monadic_fun_ty ty = mkFunTy ty ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\end{code}
Output stuff:
\begin{code}
-pprPrimOp :: PprStyle -> PrimOp -> Pretty
-showPrimOp :: PprStyle -> PrimOp -> String
+pprPrimOp :: PrimOp -> SDoc
-showPrimOp sty op
- = ppShow 1000{-random-} (pprPrimOp sty op)
-
-pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
+pprPrimOp (CCallOp fun is_casm may_gc cconv)
= let
+ callconv = text "{-" <> pprCallConv cconv <> text "-}"
+
before
- = if is_casm then
- if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
- else
- if may_gc then "(_ccall_GC_ " else "(_ccall_ "
+ | is_casm && may_gc = "__casm_GC ``"
+ | is_casm = "__casm ``"
+ | may_gc = "__ccall_GC "
+ | otherwise = "__ccall "
after
- = if is_casm then ppStr "''" else ppNil
-
- pp_tys
- = ppBesides [ppStr " { [",
- ppIntersperse pp'SP{-'-} (map (pprParendGenType sty) arg_tys),
- ppRbrack, ppSP, pprParendGenType sty res_ty, ppStr " })"]
-
- in
- ppBesides [ppStr before, ppPStr fun, after, pp_tys]
-
-pprPrimOp sty other_op
- = let
- str = primOp_str other_op
+ | is_casm = text "''"
+ | otherwise = empty
+
+ ppr_fun =
+ case fun of
+ Right _ -> ptext SLIT("<dynamic>")
+ Left fn -> ptext fn
+
in
- if codeStyle sty
- then identToC str
- else ppPStr str
-
-instance Outputable PrimOp where
- ppr sty op = pprPrimOp sty op
+ hcat [ ifPprDebug callconv
+ , text before , ppr_fun , after]
+
+pprPrimOp other_op
+ = getPprStyle $ \ sty ->
+ if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
+ ptext SLIT("PrelGHC.") <> pprOccName occ
+ else
+ pprOccName occ
+ where
+ occ = primOpOcc other_op
\end{code}