\begin{code}
module PrimOp (
PrimOp(..), allThePrimOps,
- tagOf_PrimOp, -- ToDo: rm
- primOpType,
- primOpUniq, primOpStr,
+ primOpType, primOpSig, primOpUsg,
+ mkPrimOpIdName, primOpRdrName,
commutableOp,
- primOpOutOfLine, primOpNeedsWrapper,
- primOpOkForSpeculation, primOpIsCheap,
+ primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
+ primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
primOpHasSideEffects,
getPrimOpResultInfo, PrimOpResultInfo(..),
import TysPrim
import TysWiredIn
-import CStrings ( identToC )
-import Var ( TyVar )
+import Demand ( Demand, wwLazy, wwPrim, wwStrict )
+import Var ( TyVar, Id )
import CallConv ( CallConv, pprCallConv )
import PprType ( pprParendType )
-import TyCon ( TyCon )
-import Type ( mkForAllTys, mkForAllTy, mkFunTy, mkFunTys,
- mkTyConApp, typePrimRep,
- splitAlgTyConApp, Type, isUnboxedTupleType,
- splitAlgTyConApp_maybe
+import Name ( Name, mkWiredInIdName )
+import RdrName ( RdrName, mkRdrQual )
+import OccName ( OccName, pprOccName, mkSrcVarOcc )
+import TyCon ( TyCon, tyConArity )
+import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
+ mkTyConTy, mkTyConApp, typePrimRep,
+ splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
+ UsageAnn(..), mkUsgTy
)
import Unique ( Unique, mkPrimOpIdUnique )
+import PrelMods ( pREL_GHC, pREL_GHC_Name )
import Outputable
-import Util ( assoc )
+import Util ( assoc, zipWithEqual )
import GlaExts ( Int(..), Int#, (==#) )
\end{code}
| IntAddOp | IntSubOp | IntMulOp | IntQuotOp
| IntRemOp | IntNegOp | IntAbsOp
| ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
+ | IntAddCOp
+ | IntSubCOp
+ | IntMulCOp
-- Word#-related ops:
| WordQuotOp | WordRemOp
| IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
| IntegerCmpOp
+ | IntegerCmpIntOp
| Integer2IntOp | Integer2WordOp
| Int2IntegerOp | Word2IntegerOp
| IntegerToWord64Op | Word64ToIntegerOp
-- ?? gcd, etc?
- | FloatEncodeOp | FloatDecodeOp
- | DoubleEncodeOp | DoubleDecodeOp
+ | FloatDecodeOp
+ | DoubleDecodeOp
-- primitive ops for primitive arrays
| IndexOffForeignObjOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+ | UnsafeThawArrayOp | UnsafeThawByteArrayOp
| SizeofByteArrayOp | SizeofMutableByteArrayOp
-- Mutable variables
| TakeMVarOp
| PutMVarOp
| SameMVarOp
+ | IsEmptyMVarOp
-- exceptions
| CatchOp
| RaiseOp
+ -- foreign objects
| MakeForeignObjOp
| WriteForeignObjOp
+ -- weak pointers
| MkWeakOp
| DeRefWeakOp
+ | FinalizeWeakOp
+ -- stable names
+ | MakeStableNameOp
+ | EqStableNameOp
+ | StableNameToIntOp
+
+ -- stable pointers
| MakeStablePtrOp
| DeRefStablePtrOp
| EqStablePtrOp
| 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
+ -- (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.
-- concurrency
| ForkOp
| KillThreadOp
+ | YieldOp
+ | MyThreadIdOp
| DelayOp
| WaitReadOp
| WaitWriteOp
+ -- more parallel stuff
| ParGlobalOp -- named global par
| ParLocalOp -- named local par
| ParAtOp -- specifies destination of local par
| ParAtForNowOp -- specifies initial destination of global par
| CopyableOp -- marks copyable code
| NoFollowOp -- marks non-followup expression
+
+ -- tag-related
+ | DataToTagOp
+ | TagToEnumOp
\end{code}
Used for the Ord instance
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 IntAddCOp = ILIT( 57)
+tagOf_PrimOp IntSubCOp = ILIT( 58)
+tagOf_PrimOp IntMulCOp = ILIT( 59)
+tagOf_PrimOp Int2WordOp = ILIT( 60)
+tagOf_PrimOp Word2IntOp = ILIT( 61)
+tagOf_PrimOp Int2AddrOp = ILIT( 62)
+tagOf_PrimOp Addr2IntOp = ILIT( 63)
+
+tagOf_PrimOp FloatAddOp = ILIT( 64)
+tagOf_PrimOp FloatSubOp = ILIT( 65)
+tagOf_PrimOp FloatMulOp = ILIT( 66)
+tagOf_PrimOp FloatDivOp = ILIT( 67)
+tagOf_PrimOp FloatNegOp = ILIT( 68)
+tagOf_PrimOp Float2IntOp = ILIT( 69)
+tagOf_PrimOp Int2FloatOp = ILIT( 70)
+tagOf_PrimOp FloatExpOp = ILIT( 71)
+tagOf_PrimOp FloatLogOp = ILIT( 72)
+tagOf_PrimOp FloatSqrtOp = ILIT( 73)
+tagOf_PrimOp FloatSinOp = ILIT( 74)
+tagOf_PrimOp FloatCosOp = ILIT( 75)
+tagOf_PrimOp FloatTanOp = ILIT( 76)
+tagOf_PrimOp FloatAsinOp = ILIT( 77)
+tagOf_PrimOp FloatAcosOp = ILIT( 78)
+tagOf_PrimOp FloatAtanOp = ILIT( 79)
+tagOf_PrimOp FloatSinhOp = ILIT( 80)
+tagOf_PrimOp FloatCoshOp = ILIT( 81)
+tagOf_PrimOp FloatTanhOp = ILIT( 82)
+tagOf_PrimOp FloatPowerOp = ILIT( 83)
+
+tagOf_PrimOp DoubleAddOp = ILIT( 84)
+tagOf_PrimOp DoubleSubOp = ILIT( 85)
+tagOf_PrimOp DoubleMulOp = ILIT( 86)
+tagOf_PrimOp DoubleDivOp = ILIT( 87)
+tagOf_PrimOp DoubleNegOp = ILIT( 88)
+tagOf_PrimOp Double2IntOp = ILIT( 89)
+tagOf_PrimOp Int2DoubleOp = ILIT( 90)
+tagOf_PrimOp Double2FloatOp = ILIT( 91)
+tagOf_PrimOp Float2DoubleOp = ILIT( 92)
+tagOf_PrimOp DoubleExpOp = ILIT( 93)
+tagOf_PrimOp DoubleLogOp = ILIT( 94)
+tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
+tagOf_PrimOp DoubleSinOp = ILIT( 96)
+tagOf_PrimOp DoubleCosOp = ILIT( 97)
+tagOf_PrimOp DoubleTanOp = ILIT( 98)
+tagOf_PrimOp DoubleAsinOp = ILIT( 99)
+tagOf_PrimOp DoubleAcosOp = ILIT(100)
+tagOf_PrimOp DoubleAtanOp = ILIT(101)
+tagOf_PrimOp DoubleSinhOp = ILIT(102)
+tagOf_PrimOp DoubleCoshOp = ILIT(103)
+tagOf_PrimOp DoubleTanhOp = ILIT(104)
+tagOf_PrimOp DoublePowerOp = ILIT(105)
+
+tagOf_PrimOp IntegerAddOp = ILIT(106)
+tagOf_PrimOp IntegerSubOp = ILIT(107)
+tagOf_PrimOp IntegerMulOp = ILIT(108)
+tagOf_PrimOp IntegerGcdOp = ILIT(109)
+tagOf_PrimOp IntegerQuotRemOp = ILIT(110)
+tagOf_PrimOp IntegerDivModOp = ILIT(111)
+tagOf_PrimOp IntegerNegOp = ILIT(112)
+tagOf_PrimOp IntegerCmpOp = ILIT(113)
+tagOf_PrimOp IntegerCmpIntOp = ILIT(114)
+tagOf_PrimOp Integer2IntOp = ILIT(115)
+tagOf_PrimOp Integer2WordOp = ILIT(116)
+tagOf_PrimOp Int2IntegerOp = ILIT(117)
+tagOf_PrimOp Word2IntegerOp = ILIT(118)
+tagOf_PrimOp Addr2IntegerOp = ILIT(119)
+tagOf_PrimOp IntegerToInt64Op = ILIT(120)
+tagOf_PrimOp Int64ToIntegerOp = ILIT(121)
+tagOf_PrimOp IntegerToWord64Op = ILIT(122)
+tagOf_PrimOp Word64ToIntegerOp = ILIT(123)
+tagOf_PrimOp FloatDecodeOp = ILIT(125)
+tagOf_PrimOp DoubleDecodeOp = ILIT(127)
+
+tagOf_PrimOp NewArrayOp = ILIT(128)
+tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129)
+tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130)
+tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131)
+tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132)
+tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133)
+tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134)
+tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135)
+
+tagOf_PrimOp SameMutableArrayOp = ILIT(136)
+tagOf_PrimOp SameMutableByteArrayOp = ILIT(137)
+tagOf_PrimOp ReadArrayOp = ILIT(138)
+tagOf_PrimOp WriteArrayOp = ILIT(139)
+tagOf_PrimOp IndexArrayOp = ILIT(140)
+
+tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141)
+tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142)
+tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143)
+tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144)
+tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146)
+tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147)
+tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148)
+tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149)
+
+tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150)
+tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151)
+tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152)
+tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153)
+tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155)
+tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156)
+tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157)
+tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158)
+
+tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159)
+tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160)
+tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161)
+tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162)
+tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164)
+tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165)
+tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166)
+tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167)
+
+tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168)
+tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169)
+tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170)
+tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171)
+tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173)
+tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174)
+tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175)
+tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176)
+
+tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178)
+tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)
+tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)
+tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184)
+tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)
+
+tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186)
+tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187)
+tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188)
+tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189)
+tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191)
+tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192)
+tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)
+
+tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)
+tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)
+tagOf_PrimOp UnsafeThawArrayOp = ILIT(198)
+tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(200)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201)
+
+tagOf_PrimOp NewMVarOp = ILIT(202)
+tagOf_PrimOp TakeMVarOp = ILIT(203)
+tagOf_PrimOp PutMVarOp = ILIT(204)
+tagOf_PrimOp SameMVarOp = ILIT(205)
+tagOf_PrimOp IsEmptyMVarOp = ILIT(206)
+tagOf_PrimOp MakeForeignObjOp = ILIT(207)
+tagOf_PrimOp WriteForeignObjOp = ILIT(208)
+tagOf_PrimOp MkWeakOp = ILIT(209)
+tagOf_PrimOp DeRefWeakOp = ILIT(210)
+tagOf_PrimOp FinalizeWeakOp = ILIT(211)
+tagOf_PrimOp MakeStableNameOp = ILIT(212)
+tagOf_PrimOp EqStableNameOp = ILIT(213)
+tagOf_PrimOp StableNameToIntOp = ILIT(214)
+tagOf_PrimOp MakeStablePtrOp = ILIT(215)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(216)
+tagOf_PrimOp EqStablePtrOp = ILIT(217)
+tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219)
+tagOf_PrimOp SeqOp = ILIT(220)
+tagOf_PrimOp ParOp = ILIT(221)
+tagOf_PrimOp ForkOp = ILIT(222)
+tagOf_PrimOp KillThreadOp = ILIT(223)
+tagOf_PrimOp YieldOp = ILIT(224)
+tagOf_PrimOp MyThreadIdOp = ILIT(225)
+tagOf_PrimOp DelayOp = ILIT(226)
+tagOf_PrimOp WaitReadOp = ILIT(227)
+tagOf_PrimOp WaitWriteOp = ILIT(228)
+tagOf_PrimOp ParGlobalOp = ILIT(229)
+tagOf_PrimOp ParLocalOp = ILIT(230)
+tagOf_PrimOp ParAtOp = ILIT(231)
+tagOf_PrimOp ParAtAbsOp = ILIT(232)
+tagOf_PrimOp ParAtRelOp = ILIT(233)
+tagOf_PrimOp ParAtForNowOp = ILIT(234)
+tagOf_PrimOp CopyableOp = ILIT(235)
+tagOf_PrimOp NoFollowOp = ILIT(236)
+tagOf_PrimOp NewMutVarOp = ILIT(237)
+tagOf_PrimOp ReadMutVarOp = ILIT(238)
+tagOf_PrimOp WriteMutVarOp = ILIT(239)
+tagOf_PrimOp SameMutVarOp = ILIT(240)
+tagOf_PrimOp CatchOp = ILIT(241)
+tagOf_PrimOp RaiseOp = ILIT(242)
+tagOf_PrimOp DataToTagOp = ILIT(243)
+tagOf_PrimOp TagToEnumOp = ILIT(244)
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
--panic# "tagOf_PrimOp: pattern-match"
ISllOp,
ISraOp,
ISrlOp,
+ IntAddCOp,
+ IntSubCOp,
+ IntMulCOp,
Int2WordOp,
Word2IntOp,
Int2AddrOp,
IntegerDivModOp,
IntegerNegOp,
IntegerCmpOp,
+ IntegerCmpIntOp,
Integer2IntOp,
Integer2WordOp,
Int2IntegerOp,
Int64ToIntegerOp,
IntegerToWord64Op,
Word64ToIntegerOp,
- FloatEncodeOp,
FloatDecodeOp,
- DoubleEncodeOp,
DoubleDecodeOp,
NewArrayOp,
NewByteArrayOp CharRep,
WriteOffAddrOp Word64Rep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
+ UnsafeThawArrayOp,
+ UnsafeThawByteArrayOp,
SizeofByteArrayOp,
SizeofMutableByteArrayOp,
NewMutVarOp,
TakeMVarOp,
PutMVarOp,
SameMVarOp,
+ IsEmptyMVarOp,
MakeForeignObjOp,
WriteForeignObjOp,
MkWeakOp,
DeRefWeakOp,
+ FinalizeWeakOp,
+ MakeStableNameOp,
+ EqStableNameOp,
+ StableNameToIntOp,
MakeStablePtrOp,
DeRefStablePtrOp,
EqStablePtrOp,
ParOp,
ForkOp,
KillThreadOp,
+ YieldOp,
+ MyThreadIdOp,
DelayOp,
WaitReadOp,
- WaitWriteOp
+ WaitWriteOp,
+ DataToTagOp,
+ TagToEnumOp
]
\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
+ | Monadic OccName -- string :: T -> T
Type
- | Compare FAST_STRING -- string :: T -> T -> Bool
+ | Compare OccName -- string :: T -> T -> Bool
Type
- | GenPrimOp FAST_STRING -- string :: \/a1..an . T1 -> .. -> Tk -> T
+ | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
[TyVar]
[Type]
Type
+
+mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
+mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
+mkCompare str ty = Compare (mkSrcVarOcc str) ty
+mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
\end{code}
Utility bits:
\begin{code}
-one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
+one_Integer_ty = [intPrimTy, byteArrayPrimTy]
two_Integer_tys
- = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
- intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
+ = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
+ intPrimTy, byteArrayPrimTy] -- second '' pieces
an_Integer_and_Int_tys
- = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
+ = [intPrimTy, byteArrayPrimTy, -- Integer
intPrimTy]
unboxedPair = mkUnboxedTupleTy 2
unboxedTriple = mkUnboxedTupleTy 3
unboxedQuadruple = mkUnboxedTupleTy 4
-unboxedSexTuple = mkUnboxedTupleTy 6
-integerMonadic name = GenPrimOp name [] one_Integer_ty
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+integerMonadic name = mkGenPrimOp name [] one_Integer_ty
+ (unboxedPair one_Integer_ty)
-integerDyadic name = GenPrimOp name [] two_Integer_tys
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+integerDyadic name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedPair one_Integer_ty)
-integerDyadic2Results name = GenPrimOp name [] two_Integer_tys
- (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy,
- intPrimTy, intPrimTy, byteArrayPrimTy])
+integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedQuadruple two_Integer_tys)
-integerCompare name = GenPrimOp name [] two_Integer_tys intPrimTy
+integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection{Strictness}
+%* *
+%************************************************************************
+
+Not all primops are strict!
+
+\begin{code}
+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 = ([wwStrict], False)
+ -- Seq is strict in its argument; see notes in ConFold.lhs
+
+primOpStrictness ParOp = ([wwLazy], False)
+ -- But Par is lazy, to avoid that the sparked thing
+ -- gets evaluted strictly, which it should *not* be
+
+primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
+
+primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
+primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
+
+primOpStrictness NewMutVarOp = ([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 MakeStableNameOp = ([wwLazy, wwPrim], False)
+primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
+
+primOpStrictness DataToTagOp = ([wwLazy], False)
+
+ -- The rest all have primitive-typed arguments
+primOpStrictness other = (repeat wwPrim, False)
\end{code}
%************************************************************************
There's plenty of this stuff!
\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(">#") intPrimTy
-primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
-primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
-primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
-primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
-primOpInfo IntLeOp = Compare SLIT("<=#") 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(">##") doublePrimTy
-primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
-primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
-primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
-primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
-primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
+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 = GenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
-primOpInfo ChrOp = GenPrimOp 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("+#") intPrimTy
-primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
-primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
-primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
-primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
-
-primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
-primOpInfo IntAbsOp = Monadic SLIT("absInt#") 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
+
+primOpInfo IntAddCOp =
+ mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
+
+primOpInfo IntSubCOp =
+ mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
+
+primOpInfo IntMulCOp =
+ mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
+ (unboxedPair [intPrimTy, intPrimTy])
\end{code}
%************************************************************************
A @Word#@ is an unsigned @Int#@.
\begin{code}
-primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
-primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
+primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
+primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
-primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
-primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
-primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
-primOpInfo NotOp = Monadic SLIT("not#") 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
- = GenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
+ = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
primOpInfo SrlOp
- = GenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
+ = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
primOpInfo ISllOp
- = GenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
+ = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
primOpInfo ISraOp
- = GenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
+ = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
primOpInfo ISrlOp
- = GenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
+ = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
-primOpInfo Int2WordOp = GenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
-primOpInfo Word2IntOp = GenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
+primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
+primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-primOpInfo Int2AddrOp = GenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
-primOpInfo Addr2IntOp = GenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
+primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
+primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
\end{code}
%* *
%************************************************************************
-@encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
-similar).
+@decodeFloat#@ is given w/ Integer-stuff (it'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 = GenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
-primOpInfo Int2FloatOp = GenPrimOp 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}
%************************************************************************
%* *
%************************************************************************
-@encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
-similar).
+@decodeDouble#@ is given w/ Integer-stuff (it's similar).
\begin{code}
-primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
-primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
-primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
-primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
-primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
-
-primOpInfo Double2IntOp = GenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
-primOpInfo Int2DoubleOp = GenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
-
-primOpInfo Double2FloatOp = GenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
-primOpInfo Float2DoubleOp = GenPrimOp 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("**##") 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 IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
+primOpInfo IntegerCmpIntOp
+ = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
primOpInfo Integer2IntOp
- = GenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
+ = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
primOpInfo Integer2WordOp
- = GenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
+ = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
primOpInfo Int2IntegerOp
- = GenPrimOp SLIT("int2Integer#") [] [intPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
+ (unboxedPair one_Integer_ty)
primOpInfo Word2IntegerOp
- = GenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
+ (unboxedPair one_Integer_ty)
primOpInfo Addr2IntegerOp
- = GenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
+ (unboxedPair one_Integer_ty)
primOpInfo IntegerToInt64Op
- = GenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
+ = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
primOpInfo Int64ToIntegerOp
- = GenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
+ (unboxedPair one_Integer_ty)
primOpInfo Word64ToIntegerOp
- = GenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
+ (unboxedPair one_Integer_ty)
primOpInfo IntegerToWord64Op
- = GenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
+ = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
\end{code}
-Encoding and decoding of floating-point numbers is sorta
-Integer-related.
+Decoding of floating-point numbers is sorta Integer-related. Encoding
+is done with plain ccalls now (see PrelNumExtra.lhs).
\begin{code}
-primOpInfo FloatEncodeOp
- = GenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
-
-primOpInfo DoubleEncodeOp
- = GenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
-
primOpInfo FloatDecodeOp
- = GenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
primOpInfo DoubleDecodeOp
- = GenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
- (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
+ = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
\end{code}
%************************************************************************
%* *
%************************************************************************
+\begin{verbatim}
+newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
+newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
+\end{verbatim}
+
\begin{code}
primOpInfo NewArrayOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("newArray#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
[intPrimTy, elt, state]
(unboxedPair [state, mkMutableArrayPrimTy s elt])
op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
state = mkStatePrimTy s
in
- GenPrimOp op_str [s_tv]
+ mkGenPrimOp op_str [s_tv]
[intPrimTy, state]
(unboxedPair [state, mkMutableByteArrayPrimTy s])
---------------------------------------------------------------------------
+{-
+sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
+sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
+-}
+
primOpInfo SameMutableArrayOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
mut_arr_ty = mkMutableArrayPrimTy s elt
} in
- GenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
+ mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
boolTy
primOpInfo SameMutableByteArrayOp
s = alphaTy; s_tv = alphaTyVar;
mut_arr_ty = mkMutableByteArrayPrimTy s
} in
- GenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
+ mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
boolTy
---------------------------------------------------------------------------
-- Primitive arrays of Haskell pointers:
+{-
+readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
+writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
+indexArray# :: Array# a -> Int# -> (# a #)
+-}
+
primOpInfo ReadArrayOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("readArray#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
[mkMutableArrayPrimTy s elt, intPrimTy, state]
(unboxedPair [state, elt])
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
} in
- GenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
[mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
(mkStatePrimTy s)
primOpInfo IndexArrayOp
= let { elt = alphaTy; elt_tv = alphaTyVar } in
- GenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
- (unboxedPair [realWorldStatePrimTy, elt])
+ mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
+ (mkUnboxedTupleTy 1 [elt])
---------------------------------------------------------------------------
-- Primitive arrays full of unboxed bytes:
s = alphaTy; s_tv = alphaTyVar
op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
- relevant_type = assoc "primOpInfo{ReadByteArrayOp}" tbl kind
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
state = mkStatePrimTy s
-
- tvs
- | kind == StablePtrRep = [s_tv, betaTyVar]
- | otherwise = [s_tv]
in
- GenPrimOp op_str tvs
+ mkGenPrimOp op_str (s_tv:tvs)
[mkMutableByteArrayPrimTy s, intPrimTy, state]
- (unboxedPair [state, relevant_type])
- where
- 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
+ (unboxedPair [state, prim_ty])
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])
-
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
in
- GenPrimOp op_str tvs
- [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
+ mkGenPrimOp op_str (s_tv:tvs)
+ [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
(mkStatePrimTy s)
primOpInfo (IndexByteArrayOp kind)
= let
op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([],[])
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
in
- GenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
+ mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
primOpInfo (IndexOffForeignObjOp kind)
= let
op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([], [])
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
in
- GenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
+ mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
primOpInfo (IndexOffAddrOp kind)
= let
op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
-
- (prim_tycon_args, tvs)
- | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
- | otherwise = ([], [])
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
in
- GenPrimOp op_str tvs [addrPrimTy, intPrimTy]
- (mkTyConApp (primRepTyCon kind) prim_tycon_args)
+ mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
primOpInfo (WriteOffAddrOp kind)
= let
s = alphaTy; s_tv = alphaTyVar
op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
- prim_ty = mkTyConApp (primRepTyCon kind) []
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
in
- GenPrimOp op_str [s_tv]
+ mkGenPrimOp op_str (s_tv:tvs)
[addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
(mkStatePrimTy s)
---------------------------------------------------------------------------
+{-
+unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
+unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
+unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
+unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)
+-}
+
primOpInfo UnsafeFreezeArrayOp
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
[mkMutableArrayPrimTy s elt, state]
(unboxedPair [state, mkArrayPrimTy elt])
s = alphaTy; s_tv = alphaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
+ mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
[mkMutableByteArrayPrimTy s, state]
(unboxedPair [state, byteArrayPrimTy])
+primOpInfo UnsafeThawArrayOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
+ [mkArrayPrimTy elt, state]
+ (unboxedPair [state, mkMutableArrayPrimTy s elt])
+
+primOpInfo UnsafeThawByteArrayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]
+ [byteArrayPrimTy, state]
+ (unboxedPair [state, mkMutableByteArrayPrimTy s])
+
---------------------------------------------------------------------------
primOpInfo SizeofByteArrayOp
- = GenPrimOp
+ = mkGenPrimOp
SLIT("sizeofByteArray#") []
[byteArrayPrimTy]
intPrimTy
primOpInfo SizeofMutableByteArrayOp
= let { s = alphaTy; s_tv = alphaTyVar } in
- GenPrimOp
+ mkGenPrimOp
SLIT("sizeofMutableByteArray#") [s_tv]
[mkMutableByteArrayPrimTy s]
intPrimTy
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
[elt, state]
(unboxedPair [state, mkMutVarPrimTy s elt])
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
state = mkStatePrimTy s
} in
- GenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
[mkMutVarPrimTy s elt, state]
(unboxedPair [state, elt])
= let {
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
} in
- GenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
[mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
(mkStatePrimTy s)
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
mut_var_ty = mkMutVarPrimTy s elt
} in
- GenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
+ mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
boolTy
\end{code}
%* *
%************************************************************************
-catch :: IO a -> (IOError -> IO a) -> IO a
-catch :: a -> (b -> a) -> a
+catch :: IO a -> (IOError -> IO a) -> IO a
+catch# :: a -> (b -> a) -> a
\begin{code}
primOpInfo CatchOp
= let
- a = alphaTy; a_tv = alphaTyVar;
+ a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
- GenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
+ mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
primOpInfo RaiseOp
= let
- a = alphaTy; a_tv = alphaTyVar;
+ a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
in
- GenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
+ mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
\end{code}
%************************************************************************
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
state = mkStatePrimTy s
in
- GenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
+ mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
(unboxedPair [state, mkMVarPrimTy s elt])
primOpInfo TakeMVarOp
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
state = mkStatePrimTy s
in
- GenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
[mkMVarPrimTy s elt, state]
(unboxedPair [state, elt])
= let
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
in
- GenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
+ mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
[mkMVarPrimTy s elt, elt, mkStatePrimTy s]
(mkStatePrimTy s)
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
mvar_ty = mkMVarPrimTy s elt
in
- GenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
+ mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
+
+primOpInfo IsEmptyMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, mkStatePrimTy s]
+ (unboxedPair [state, intPrimTy])
+
\end{code}
%************************************************************************
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- GenPrimOp SLIT("delay#") [s_tv]
+ mkGenPrimOp SLIT("delay#") [s_tv]
[intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
primOpInfo WaitReadOp
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- GenPrimOp SLIT("waitRead#") [s_tv]
+ mkGenPrimOp SLIT("waitRead#") [s_tv]
[intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
primOpInfo WaitWriteOp
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- GenPrimOp SLIT("waitWrite#") [s_tv]
+ mkGenPrimOp SLIT("waitWrite#") [s_tv]
[intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\end{code}
\begin{code}
-- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
primOpInfo ForkOp
- = GenPrimOp SLIT("fork#") [alphaTyVar]
+ = mkGenPrimOp SLIT("fork#") [alphaTyVar]
[alphaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
--- killThread# :: ThreadId# -> State# RealWorld -> State# RealWorld
+-- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
primOpInfo KillThreadOp
- = GenPrimOp SLIT("killThread#") []
- [threadIdPrimTy, realWorldStatePrimTy]
+ = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
+ [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
+ realWorldStatePrimTy
+
+-- yield# :: State# RealWorld -> State# RealWorld
+primOpInfo YieldOp
+ = mkGenPrimOp SLIT("yield#") []
+ [realWorldStatePrimTy]
realWorldStatePrimTy
+
+-- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
+primOpInfo MyThreadIdOp
+ = mkGenPrimOp SLIT("myThreadId#") []
+ [realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
\end{code}
************************************************************************
\begin{code}
primOpInfo MakeForeignObjOp
- = GenPrimOp SLIT("makeForeignObj#") []
+ = mkGenPrimOp SLIT("makeForeignObj#") []
[addrPrimTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
= let {
s = alphaTy; s_tv = alphaTyVar
} in
- GenPrimOp SLIT("writeForeignObj#") [s_tv]
+ mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
[foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\end{code}
\begin{code}
primOpInfo MkWeakOp
- = GenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
+ = 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
+may have been finalized, so the operation returns a result code which
must be inspected before looking at the dereferenced value.
deRefWeak# :: Weak# v -> State# RealWorld ->
\begin{code}
primOpInfo DeRefWeakOp
- = GenPrimOp SLIT("deRefWeak#") [alphaTyVar]
+ = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
[mkWeakPrimTy alphaTy, realWorldStatePrimTy]
(unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
\end{code}
+Weak pointers can be finalized early by using the finalize# operation:
+
+ finalizeWeak# :: Weak# v -> State# RealWorld ->
+ (# State# RealWorld, Int#, IO () #)
+
+The Int# returned is either
+
+ 0 if the weak pointer has already been finalized, or it has no
+ finalizer (the third component is then invalid).
+
+ 1 if the weak pointer is still alive, with the finalizer returned
+ as the third component.
+
+\begin{code}
+primOpInfo FinalizeWeakOp
+ = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
+ [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
+ (unboxedTriple [realWorldStatePrimTy, intPrimTy,
+ mkFunTy realWorldStatePrimTy
+ (unboxedPair [realWorldStatePrimTy,unitTy])])
+\end{code}
+
%************************************************************************
%* *
-\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
+\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
%* *
%************************************************************************
-A {\em stable pointer} is an index into a table of pointers into the
-heap. Since the garbage collector is told about stable pointers, it
-is safe to pass a stable pointer to external systems such as C
+A {\em stable name/pointer} is an index into a table of stable name
+entries. Since the garbage collector is told about stable pointers,
+it is safe to pass a stable pointer to external systems such as C
routines.
-Here's what the operations and types are supposed to be (from
-state-interface document).
-
\begin{verbatim}
-makeStablePtr# :: a -> State# _RealWorld -> (# State# _RealWorld, a #)
-freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
-deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> (# State# _RealWorld, a #)
+makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
+freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
+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@
+It may seem a bit surprising that @makeStablePtr#@ is a @IO@
operation since it doesn't (directly) involve IO operations. The
reason is that if some optimisation pass decided to duplicate calls to
@makeStablePtr#@ and we only pass one of the stable pointers over, a
-massive space leak can result. Putting it into the PrimIO monad
+massive space leak can result. Putting it into the IO monad
prevents this. (Another reason for putting them in a monad is to
-ensure correct sequencing wrt the side-effecting @freeStablePtr#@
+ensure correct sequencing wrt the side-effecting @freeStablePtr@
operation.)
+An important property of stable pointers is that if you call
+makeStablePtr# twice on the same object you get the same stable
+pointer back.
+
Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
besides, it's not likely to be used from Haskell) so it's not a
primop.
-Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
+Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
+
+Stable Names
+~~~~~~~~~~~~
+
+A stable name is like a stable pointer, but with three important differences:
+
+ (a) You can't deRef one to get back to the original object.
+ (b) You can convert one to an Int.
+ (c) You don't need to 'freeStableName'
+
+The existence of a stable name doesn't guarantee to keep the object it
+points to alive (unlike a stable pointer), hence (a).
+
+Invariants:
+
+ (a) makeStableName always returns the same value for a given
+ object (same as stable pointers).
+
+ (b) if two stable names are equal, it implies that the objects
+ from which they were created were the same.
+
+ (c) stableNameToInt always returns the same Int for a given
+ stable name.
\begin{code}
primOpInfo MakeStablePtrOp
- = GenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
+ = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
[alphaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy,
mkTyConApp stablePtrPrimTyCon [alphaTy]])
primOpInfo DeRefStablePtrOp
- = GenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
+ = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
[mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, alphaTy])
primOpInfo EqStablePtrOp
- = GenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
+ = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
[mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
intPrimTy
+
+primOpInfo MakeStableNameOp
+ = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
+ [alphaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy,
+ mkTyConApp stableNamePrimTyCon [alphaTy]])
+
+primOpInfo EqStableNameOp
+ = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
+ [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
+ intPrimTy
+
+primOpInfo StableNameToIntOp
+ = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
+ [mkStableNamePrimTy alphaTy]
+ intPrimTy
\end{code}
%************************************************************************
\begin{code}
primOpInfo ReallyUnsafePtrEqualityOp
- = GenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
+ = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
[alphaTy, alphaTy] intPrimTy
\end{code}
\begin{code}
primOpInfo SeqOp -- seq# :: a -> Int#
- = GenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
+ = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
primOpInfo ParOp -- par# :: a -> Int#
- = GenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
+ = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
\end{code}
\begin{code}
-- 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#
+-- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
+-- `the processor containing the expression v'; it is not evaluated
-primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = GenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
+primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = GenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
+primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
- = GenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
+primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
-primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = GenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
+primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
- = GenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
+primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
-primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
- = GenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
+primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
-primOpInfo CopyableOp -- copyable# :: a -> a
- = GenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
+primOpInfo CopyableOp -- copyable# :: a -> Int#
+ = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
-primOpInfo NoFollowOp -- noFollow# :: a -> a
- = GenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
+primOpInfo NoFollowOp -- noFollow# :: a -> Int#
+ = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
\end{code}
%************************************************************************
\begin{code}
primOpInfo (CCallOp _ _ _ _)
- = GenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
+ = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
{-
primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
- = GenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
+ = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
where
(result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
-}
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
+%* *
+%************************************************************************
+
+These primops are pretty wierd.
+
+ dataToTag# :: a -> Int (arg must be an evaluated data type)
+ tagToEnum# :: Int -> a (result type must be an enumerated type)
+
+The constraints aren't currently checked by the front end, but the
+code generator will fall over if they aren't satisfied.
+
+\begin{code}
+primOpInfo DataToTagOp
+ = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
+
+primOpInfo TagToEnumOp
+ = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
+
#ifdef DEBUG
primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
#endif
\end{code}
+%************************************************************************
+%* *
+\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
+%* *
+%************************************************************************
+
Some PrimOps need to be called out-of-line because they either need to
perform a heap check or they block.
FloatDecodeOp -> True
DoubleDecodeOp -> True
MkWeakOp -> True
- DeRefWeakOp -> True
+ FinalizeWeakOp -> True
+ MakeStableNameOp -> True
MakeForeignObjOp -> True
- MakeStablePtrOp -> True
NewMutVarOp -> True
NewMVarOp -> True
ForkOp -> True
KillThreadOp -> True
+ YieldOp -> True
CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
+ -- the next one doesn't perform any heap checks,
+ -- but it is of such an esoteric nature that
+ -- it is done out-of-line rather than require
+ -- the NCG to implement it.
+ UnsafeThawArrayOp -> True
_ -> False
\end{code}
primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
\end{code}
+primOpIsDupable means that the use of the primop is small enough to
+duplicate into different case branches. See CoreUtils.exprIsDupable.
+
+\begin{code}
+primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc
+ -- If the ccall can't GC then the call is pretty cheap, and
+ -- we're happy to duplicate
+primOpIsDupable op = not (primOpOutOfLine op)
+\end{code}
+
+
\begin{code}
primOpCanFail :: PrimOp -> Bool
-- Int.
primOpCanFail DoubleAsinOp = True -- Arg out of domain
primOpCanFail DoubleAcosOp = True -- Arg out of domain
--- The default is "yes it's ok for speculation"
-primOpCanFail other_op = True
+primOpCanFail other_op = False
\end{code}
And some primops have side-effects and so, for example, must not be
primOpHasSideEffects ParOp = True
primOpHasSideEffects ForkOp = True
primOpHasSideEffects KillThreadOp = True
+primOpHasSideEffects YieldOp = True
primOpHasSideEffects SeqOp = True
primOpHasSideEffects MakeForeignObjOp = True
primOpHasSideEffects WriteForeignObjOp = True
primOpHasSideEffects MkWeakOp = True
primOpHasSideEffects DeRefWeakOp = True
+primOpHasSideEffects FinalizeWeakOp = True
primOpHasSideEffects MakeStablePtrOp = True
+primOpHasSideEffects MakeStableNameOp = True
primOpHasSideEffects EqStablePtrOp = True -- SOF
primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
primOpNeedsWrapper Integer2IntOp = True
primOpNeedsWrapper Integer2WordOp = True
primOpNeedsWrapper IntegerCmpOp = True
+primOpNeedsWrapper IntegerCmpIntOp = True
primOpNeedsWrapper FloatExpOp = True
primOpNeedsWrapper FloatLogOp = True
primOpNeedsWrapper FloatCoshOp = True
primOpNeedsWrapper FloatTanhOp = True
primOpNeedsWrapper FloatPowerOp = True
-primOpNeedsWrapper FloatEncodeOp = True
primOpNeedsWrapper DoubleExpOp = True
primOpNeedsWrapper DoubleLogOp = True
primOpNeedsWrapper DoubleCoshOp = True
primOpNeedsWrapper DoubleTanhOp = True
primOpNeedsWrapper DoublePowerOp = True
-primOpNeedsWrapper DoubleEncodeOp = True
-primOpNeedsWrapper MakeStablePtrOp = True
+primOpNeedsWrapper MakeStableNameOp = True
primOpNeedsWrapper DeRefStablePtrOp = True
primOpNeedsWrapper DelayOp = True
\end{code}
\begin{code}
-primOpStr op
+primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
+primOpType op
= case (primOpInfo op) of
- Dyadic str _ -> str
- Monadic str _ -> str
- Compare str _ -> str
- GenPrimOp str _ _ _ -> str
-\end{code}
+ Dyadic occ ty -> dyadic_fun_ty ty
+ Monadic occ ty -> monadic_fun_ty ty
+ Compare occ ty -> compare_fun_ty ty
-\begin{code}
-primOpUniq :: PrimOp -> Unique
-primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
+ GenPrimOp occ tyvars arg_tys res_ty ->
+ mkForAllTys tyvars (mkFunTys arg_tys res_ty)
-primOpType :: PrimOp -> Type
-primOpType op
+mkPrimOpIdName :: PrimOp -> Id -> Name
+ -- Make the name for the PrimOp's Id
+ -- We have to pass in the Id itself because it's a WiredInId
+ -- and hence recursive
+mkPrimOpIdName op id
+ = mkWiredInIdName key pREL_GHC occ_name id
+ where
+ occ_name = primOpOcc op
+ key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
+
+
+primOpRdrName :: PrimOp -> RdrName
+primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
+
+primOpOcc :: PrimOp -> OccName
+primOpOcc op = case (primOpInfo op) of
+ Dyadic occ _ -> occ
+ Monadic occ _ -> occ
+ Compare occ _ -> occ
+ GenPrimOp occ _ _ _ -> occ
+
+-- primOpSig is like primOpType but gives the result split apart:
+-- (type variables, argument types, result type)
+
+primOpSig :: PrimOp -> ([TyVar],[Type],Type)
+primOpSig 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
+ Monadic occ ty -> ([], [ty], ty )
+ Dyadic occ ty -> ([], [ty,ty], ty )
+ Compare occ ty -> ([], [ty,ty], boolTy)
+ GenPrimOp occ tyvars arg_tys res_ty
+ -> (tyvars, arg_tys, res_ty)
+
+-- primOpUsg is like primOpSig but the types it yields are the
+-- appropriate sigma (i.e., usage-annotated) types,
+-- as required by the UsageSP inference.
+
+primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
+primOpUsg op
+ = case op of
- GenPrimOp str tyvars arg_tys res_ty ->
- mkForAllTys tyvars (mkFunTys arg_tys res_ty)
+ -- Refer to comment by `otherwise' clause; we need consider here
+ -- *only* primops that have arguments or results containing Haskell
+ -- pointers (things that are pointed). Unpointed values are
+ -- irrelevant to the usage analysis. The issue is whether pointed
+ -- values may be entered or duplicated by the primop.
+
+ -- Remember that primops are *never* partially applied.
+
+ NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
+ SameMutableArrayOp -> mangle [mkP, mkP ] mkM
+ ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
+ WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
+ IndexArrayOp -> mangle [mkM, mkP ] mkM
+ UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
+ UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
+
+ NewMutVarOp -> mangle [mkM, mkP ] mkM
+ ReadMutVarOp -> mangle [mkM, mkP ] mkM
+ WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
+ SameMutVarOp -> mangle [mkP, mkP ] mkM
+
+ CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
+ mangle [mkM, mkM . (inFun mkM mkM)] mkM
+ -- might use caught action multiply
+ RaiseOp -> mangle [mkM ] mkM
+
+ NewMVarOp -> mangle [mkP ] mkR
+ TakeMVarOp -> mangle [mkM, mkP ] mkM
+ PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
+ SameMVarOp -> mangle [mkP, mkP ] mkM
+ IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
+
+ ForkOp -> mangle [mkO, mkP ] mkR
+ KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
+
+ MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
+ DeRefWeakOp -> mangle [mkM, mkP ] mkM
+ FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
+
+ MakeStablePtrOp -> mangle [mkM, mkP ] mkM
+ DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
+ EqStablePtrOp -> mangle [mkP, mkP ] mkR
+ MakeStableNameOp -> mangle [mkZ, mkP ] mkR
+ EqStableNameOp -> mangle [mkP, mkP ] mkR
+ StableNameToIntOp -> mangle [mkP ] mkR
+
+ ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
+
+ SeqOp -> mangle [mkO ] mkR
+ ParOp -> mangle [mkO ] mkR
+ ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
+ ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
+ ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
+ ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
+ ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
+ ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
+ CopyableOp -> mangle [mkZ ] mkR
+ NoFollowOp -> mangle [mkZ ] mkR
+
+ CCallOp _ _ _ _ -> mangle [ ] mkM
+
+ -- Things with no Haskell pointers inside: in actuality, usages are
+ -- irrelevant here (hence it doesn't matter that some of these
+ -- apparently permit duplication; since such arguments are never
+ -- ENTERed anyway, the usage annotation they get is entirely irrelevant
+ -- except insofar as it propagates to infect other values that *are*
+ -- pointed.
+
+ otherwise -> nomangle
+
+ where mkZ = mkUsgTy UsOnce -- pointed argument used zero
+ mkO = mkUsgTy UsOnce -- pointed argument used once
+ mkM = mkUsgTy UsMany -- pointed argument used multiply
+ mkP = mkUsgTy UsOnce -- unpointed argument
+ mkR = mkUsgTy UsMany -- unpointed result
+
+ (tyvars, arg_tys, res_ty)
+ = primOpSig op
+
+ nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
+
+ mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
+
+ inFun f g ty = case splitFunTy_maybe ty of
+ Just (a,b) -> mkFunTy (f a) (g b)
+ Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
+
+ inUB fs ty = case splitTyConApp_maybe ty of
+ Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
+ mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
+ ($) fs tys)
+ Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
\end{code}
\begin{code}
-- be out of line, or the code generator won't work.
getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
-
getPrimOpResultInfo op
= case (primOpInfo op) of
Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
Monadic _ ty -> ReturnsPrim (typePrimRep ty)
- Compare _ ty -> ReturnsAlg boolTyCon
+ Compare _ ty -> ReturnsAlg boolTyCon
GenPrimOp _ _ _ ty ->
let rep = typePrimRep ty in
case rep of
other -> ReturnsPrim other
isCompareOp :: PrimOp -> Bool
-
isCompareOp op
= case primOpInfo op of
Compare _ _ -> True
Utils:
\begin{code}
+mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
+ -- CharRep --> ([], Char#)
+ -- StablePtrRep --> ([a], StablePtr# a)
+mkPrimTyApp tvs kind
+ = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
+ where
+ tycon = primRepTyCon kind
+ forall_tvs = take (tyConArity tycon) tvs
+
dyadic_fun_ty ty = mkFunTys [ty, ty] ty
monadic_fun_ty ty = mkFunTy ty ty
compare_fun_ty ty = mkFunTys [ty, ty] boolTy
callconv = text "{-" <> pprCallConv cconv <> text "-}"
before
- | is_casm && may_gc = "__casm_GC ``"
- | is_casm = "__casm ``"
- | may_gc = "__ccall_GC "
- | otherwise = "__ccall "
+ | is_casm && may_gc = "casm_GC ``"
+ | is_casm = "casm ``"
+ | may_gc = "ccall_GC "
+ | otherwise = "ccall "
after
| is_casm = text "''"
| otherwise = empty
+
+ ppr_dyn =
+ case fun of
+ Right _ -> text "dyn_"
+ _ -> empty
ppr_fun =
case fun of
- Right _ -> ptext SLIT("<dynamic>")
+ Right _ -> text "\"\""
Left fn -> ptext fn
in
hcat [ ifPprDebug callconv
+ , text "__", ppr_dyn
, text before , ppr_fun , after]
pprPrimOp other_op
= getPprStyle $ \ sty ->
- if codeStyle sty then -- For C just print the primop itself
- identToC str
- else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
- ptext SLIT("PrelGHC.") <> ptext str
- else -- Unqualified is good enough
- ptext str
+ if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
+ ptext SLIT("PrelGHC.") <> pprOccName occ
+ else
+ pprOccName occ
where
- str = primOpStr other_op
+ occ = primOpOcc other_op
\end{code}