\begin{code}
module PrimOp (
PrimOp(..), allThePrimOps,
- primOpType, primOpSig, primOpUsg,
- mkPrimOpIdName, primOpRdrName,
+ primOpType, primOpSig, primOpUsg, primOpArity,
+ mkPrimOpIdName, primOpRdrName, primOpTag, primOpOcc,
commutableOp,
- primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
+ primOpOutOfLine, primOpNeedsWrapper,
primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
primOpHasSideEffects,
getPrimOpResultInfo, PrimOpResultInfo(..),
- pprPrimOp
+ pprPrimOp,
+
+ CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp,
+ isDynamicTarget, dynamicTarget, setCCallUnique
) where
#include "HsVersions.h"
import TysPrim
import TysWiredIn
-import Demand ( Demand, wwLazy, wwPrim, wwStrict )
+import Demand ( Demand, wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
import Var ( TyVar, Id )
import CallConv ( CallConv, pprCallConv )
import PprType ( pprParendType )
import OccName ( OccName, pprOccName, mkSrcVarOcc )
import TyCon ( TyCon, tyConArity )
import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
- mkTyConTy, mkTyConApp, typePrimRep,
+ mkTyConTy, mkTyConApp, typePrimRep,mkTyVarTy,
splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
UsageAnn(..), mkUsgTy
)
import Unique ( Unique, mkPrimOpIdUnique )
-import PrelMods ( pREL_GHC, pREL_GHC_Name )
+import BasicTypes ( Arity, Boxity(..) )
+import CStrings ( CLabelString, pprCLabelString )
+import PrelNames ( pREL_GHC, pREL_GHC_Name )
import Outputable
import Util ( assoc, zipWithEqual )
import GlaExts ( Int(..), Int#, (==#) )
| OrdOp | ChrOp
-- Int#-related ops:
- -- IntAbsOp unused?? ADR
| IntAddOp | IntSubOp | IntMulOp | IntQuotOp
- | IntRemOp | IntNegOp | IntAbsOp
+ | IntRemOp | IntNegOp
| ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
| IntAddCOp
| IntSubCOp
| IntMulCOp
+ | IntGcdOp
-- Word#-related ops:
| WordQuotOp | WordRemOp
-- slightly weird -- to match GMP package.
| IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
| IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
+ | IntegerIntGcdOp | IntegerDivExactOp
+ | IntegerQuotOp | IntegerRemOp
| IntegerCmpOp
| IntegerCmpIntOp
| ReadByteArrayOp PrimRep
| WriteByteArrayOp PrimRep
| IndexByteArrayOp PrimRep
- | IndexOffAddrOp PrimRep
+ | ReadOffAddrOp PrimRep
| WriteOffAddrOp PrimRep
- -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
+ | IndexOffAddrOp PrimRep
+ -- PrimRep can be one of :
+ -- {Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep.
-- This is just a cheesy encoding of a bunch of ops.
-- Note that ForeignObjRep is not included -- the only way of
-- creating a ForeignObj is with a ccall or casm.
| IndexOffForeignObjOp PrimRep
| UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
- | UnsafeThawArrayOp | UnsafeThawByteArrayOp
+ | UnsafeThawArrayOp
| SizeofByteArrayOp | SizeofMutableByteArrayOp
-- Mutable variables
| TakeMVarOp
| PutMVarOp
| SameMVarOp
+ | TryTakeMVarOp
| IsEmptyMVarOp
-- exceptions
| CatchOp
| RaiseOp
+ | BlockAsyncExceptionsOp
+ | UnblockAsyncExceptionsOp
-- foreign objects
- | MakeForeignObjOp
+ | MkForeignObjOp
| WriteForeignObjOp
-- weak pointers
| MakeStablePtrOp
| DeRefStablePtrOp
| EqStablePtrOp
-\end{code}
-
-A special ``trap-door'' to use in making calls direct to C functions:
-\begin{code}
- | 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}
-
-The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
-(See @primOpInfo@ for details.)
-
-Note: that first arg and part of the result should be the system state
-token (which we carry around to fool over-zealous optimisers) but
-which isn't actually passed.
-
-For example, we represent
-\begin{pseudocode}
-((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
-\end{pseudocode}
-by
-\begin{pseudocode}
-Case
- ( Prim
- (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
- -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
- []
- [w#, sp# i#]
- )
- (AlgAlts [ ( FloatPrimAndIoWorld,
- [f#, w#],
- Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
- ) ]
- NoDefault
- )
-\end{pseudocode}
-
-Nota Bene: there are some people who find the empty list of types in
-the @Prim@ somewhat puzzling and would represent the above by
-\begin{pseudocode}
-Case
- ( Prim
- (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
- -- :: /\ alpha1, alpha2 alpha3, alpha4.
- -- alpha1 -> alpha2 -> alpha3 -> alpha4
- [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
- [w#, sp# i#]
- )
- (AlgAlts [ ( FloatPrimAndIoWorld,
- [f#, w#],
- Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
- ) ]
- NoDefault
- )
-\end{pseudocode}
-
-But, this is a completely different way of using @CCallOp@. The most
-major changes required if we switch to this are in @primOpInfo@, and
-the desugarer. The major difficulty is in moving the HeapRequirement
-stuff somewhere appropriate. (The advantage is that we could simplify
-@CCallOp@ and record just the number of arguments with corresponding
-simplifications in reading pragma unfoldings, the simplifier,
-instantiation (etc) of core expressions, ... . Maybe we should think
-about using it this way?? ADR)
-
-\begin{code}
- -- (... continued from above ... )
+ -- Foreign calls
+ | CCallOp CCall
-- Operation to test two closure addresses for equality (yes really!)
-- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
| ReallyUnsafePtrEqualityOp
Used for the Ord instance
\begin{code}
+primOpTag :: PrimOp -> Int
+primOpTag op = IBOX( tagOf_PrimOp op )
+
tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
tagOf_PrimOp CharGeOp = ILIT( 2)
tagOf_PrimOp CharEqOp = ILIT( 3)
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 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 IntGcdOp = ILIT( 43)
+tagOf_PrimOp IntRemOp = ILIT( 44)
+tagOf_PrimOp IntNegOp = ILIT( 45)
+tagOf_PrimOp WordQuotOp = ILIT( 47)
+tagOf_PrimOp WordRemOp = ILIT( 48)
+tagOf_PrimOp AndOp = ILIT( 49)
+tagOf_PrimOp OrOp = ILIT( 50)
+tagOf_PrimOp NotOp = ILIT( 51)
+tagOf_PrimOp XorOp = ILIT( 52)
+tagOf_PrimOp SllOp = ILIT( 53)
+tagOf_PrimOp SrlOp = ILIT( 54)
+tagOf_PrimOp ISllOp = ILIT( 55)
+tagOf_PrimOp ISraOp = ILIT( 56)
+tagOf_PrimOp ISrlOp = ILIT( 57)
+tagOf_PrimOp IntAddCOp = ILIT( 58)
+tagOf_PrimOp IntSubCOp = ILIT( 59)
+tagOf_PrimOp IntMulCOp = ILIT( 60)
+tagOf_PrimOp Int2WordOp = ILIT( 61)
+tagOf_PrimOp Word2IntOp = ILIT( 62)
+tagOf_PrimOp Int2AddrOp = ILIT( 63)
+tagOf_PrimOp Addr2IntOp = ILIT( 64)
+tagOf_PrimOp FloatAddOp = ILIT( 65)
+tagOf_PrimOp FloatSubOp = ILIT( 66)
+tagOf_PrimOp FloatMulOp = ILIT( 67)
+tagOf_PrimOp FloatDivOp = ILIT( 68)
+tagOf_PrimOp FloatNegOp = ILIT( 69)
+tagOf_PrimOp Float2IntOp = ILIT( 70)
+tagOf_PrimOp Int2FloatOp = ILIT( 71)
+tagOf_PrimOp FloatExpOp = ILIT( 72)
+tagOf_PrimOp FloatLogOp = ILIT( 73)
+tagOf_PrimOp FloatSqrtOp = ILIT( 74)
+tagOf_PrimOp FloatSinOp = ILIT( 75)
+tagOf_PrimOp FloatCosOp = ILIT( 76)
+tagOf_PrimOp FloatTanOp = ILIT( 77)
+tagOf_PrimOp FloatAsinOp = ILIT( 78)
+tagOf_PrimOp FloatAcosOp = ILIT( 79)
+tagOf_PrimOp FloatAtanOp = ILIT( 80)
+tagOf_PrimOp FloatSinhOp = ILIT( 81)
+tagOf_PrimOp FloatCoshOp = ILIT( 82)
+tagOf_PrimOp FloatTanhOp = ILIT( 83)
+tagOf_PrimOp FloatPowerOp = ILIT( 84)
+tagOf_PrimOp DoubleAddOp = ILIT( 85)
+tagOf_PrimOp DoubleSubOp = ILIT( 86)
+tagOf_PrimOp DoubleMulOp = ILIT( 87)
+tagOf_PrimOp DoubleDivOp = ILIT( 88)
+tagOf_PrimOp DoubleNegOp = ILIT( 89)
+tagOf_PrimOp Double2IntOp = ILIT( 90)
+tagOf_PrimOp Int2DoubleOp = ILIT( 91)
+tagOf_PrimOp Double2FloatOp = ILIT( 92)
+tagOf_PrimOp Float2DoubleOp = ILIT( 93)
+tagOf_PrimOp DoubleExpOp = ILIT( 94)
+tagOf_PrimOp DoubleLogOp = ILIT( 95)
+tagOf_PrimOp DoubleSqrtOp = ILIT( 96)
+tagOf_PrimOp DoubleSinOp = ILIT( 97)
+tagOf_PrimOp DoubleCosOp = ILIT( 98)
+tagOf_PrimOp DoubleTanOp = ILIT( 99)
+tagOf_PrimOp DoubleAsinOp = ILIT(100)
+tagOf_PrimOp DoubleAcosOp = ILIT(101)
+tagOf_PrimOp DoubleAtanOp = ILIT(102)
+tagOf_PrimOp DoubleSinhOp = ILIT(103)
+tagOf_PrimOp DoubleCoshOp = ILIT(104)
+tagOf_PrimOp DoubleTanhOp = ILIT(105)
+tagOf_PrimOp DoublePowerOp = ILIT(106)
+tagOf_PrimOp IntegerAddOp = ILIT(107)
+tagOf_PrimOp IntegerSubOp = ILIT(108)
+tagOf_PrimOp IntegerMulOp = ILIT(109)
+tagOf_PrimOp IntegerGcdOp = ILIT(110)
+tagOf_PrimOp IntegerIntGcdOp = ILIT(111)
+tagOf_PrimOp IntegerDivExactOp = ILIT(112)
+tagOf_PrimOp IntegerQuotOp = ILIT(113)
+tagOf_PrimOp IntegerRemOp = ILIT(114)
+tagOf_PrimOp IntegerQuotRemOp = ILIT(115)
+tagOf_PrimOp IntegerDivModOp = ILIT(116)
+tagOf_PrimOp IntegerNegOp = ILIT(117)
+tagOf_PrimOp IntegerCmpOp = ILIT(118)
+tagOf_PrimOp IntegerCmpIntOp = ILIT(119)
+tagOf_PrimOp Integer2IntOp = ILIT(120)
+tagOf_PrimOp Integer2WordOp = ILIT(121)
+tagOf_PrimOp Int2IntegerOp = ILIT(122)
+tagOf_PrimOp Word2IntegerOp = ILIT(123)
+tagOf_PrimOp Addr2IntegerOp = ILIT(125)
+tagOf_PrimOp IntegerToInt64Op = ILIT(127)
+tagOf_PrimOp Int64ToIntegerOp = ILIT(128)
+tagOf_PrimOp IntegerToWord64Op = ILIT(129)
+tagOf_PrimOp Word64ToIntegerOp = ILIT(130)
+tagOf_PrimOp FloatDecodeOp = ILIT(131)
+tagOf_PrimOp DoubleDecodeOp = ILIT(132)
+tagOf_PrimOp NewArrayOp = ILIT(133)
+tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134)
+tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135)
+tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136)
+tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137)
+tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138)
+tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139)
+tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140)
+tagOf_PrimOp SameMutableArrayOp = ILIT(141)
+tagOf_PrimOp SameMutableByteArrayOp = ILIT(142)
+tagOf_PrimOp ReadArrayOp = ILIT(143)
+tagOf_PrimOp WriteArrayOp = ILIT(144)
+tagOf_PrimOp IndexArrayOp = ILIT(145)
+tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146)
+tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147)
+tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148)
+tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149)
+tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150)
+tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151)
+tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152)
+tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153)
+tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154)
+tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155)
+tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156)
+tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157)
+tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158)
+tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159)
+tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160)
+tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161)
+tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162)
+tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163)
+tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164)
+tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165)
+tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166)
+tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167)
+tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168)
+tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169)
+tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170)
+tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171)
+tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172)
+tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173)
+tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174)
+tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175)
+tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176)
+tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177)
+tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178)
+tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179)
+tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180)
+tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181)
+tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182)
+tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183)
+tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184)
+tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185)
+tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186)
+tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
+tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
+tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189)
+tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
+tagOf_PrimOp (ReadOffAddrOp CharRep) = ILIT(191)
+tagOf_PrimOp (ReadOffAddrOp IntRep) = ILIT(192)
+tagOf_PrimOp (ReadOffAddrOp WordRep) = ILIT(193)
+tagOf_PrimOp (ReadOffAddrOp AddrRep) = ILIT(194)
+tagOf_PrimOp (ReadOffAddrOp FloatRep) = ILIT(195)
+tagOf_PrimOp (ReadOffAddrOp DoubleRep) = ILIT(196)
+tagOf_PrimOp (ReadOffAddrOp StablePtrRep) = ILIT(197)
+tagOf_PrimOp (ReadOffAddrOp ForeignObjRep) = ILIT(198)
+tagOf_PrimOp (ReadOffAddrOp Int64Rep) = ILIT(199)
+tagOf_PrimOp (ReadOffAddrOp Word64Rep) = ILIT(200)
+tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(201)
+tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(202)
+tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(203)
+tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(205)
+tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(206)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(207)
+tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(208)
+tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(209)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(210)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(211)
+tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(212)
+tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(213)
+tagOf_PrimOp UnsafeThawArrayOp = ILIT(214)
+tagOf_PrimOp SizeofByteArrayOp = ILIT(215)
+tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(216)
+tagOf_PrimOp NewMVarOp = ILIT(217)
+tagOf_PrimOp TakeMVarOp = ILIT(218)
+tagOf_PrimOp PutMVarOp = ILIT(219)
+tagOf_PrimOp SameMVarOp = ILIT(220)
+tagOf_PrimOp TryTakeMVarOp = ILIT(221)
+tagOf_PrimOp IsEmptyMVarOp = ILIT(222)
+tagOf_PrimOp MkForeignObjOp = ILIT(223)
+tagOf_PrimOp WriteForeignObjOp = ILIT(224)
+tagOf_PrimOp MkWeakOp = ILIT(225)
+tagOf_PrimOp DeRefWeakOp = ILIT(226)
+tagOf_PrimOp FinalizeWeakOp = ILIT(227)
+tagOf_PrimOp MakeStableNameOp = ILIT(228)
+tagOf_PrimOp EqStableNameOp = ILIT(229)
+tagOf_PrimOp StableNameToIntOp = ILIT(230)
+tagOf_PrimOp MakeStablePtrOp = ILIT(231)
+tagOf_PrimOp DeRefStablePtrOp = ILIT(232)
+tagOf_PrimOp EqStablePtrOp = ILIT(234)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(235)
+tagOf_PrimOp SeqOp = ILIT(236)
+tagOf_PrimOp ParOp = ILIT(237)
+tagOf_PrimOp ForkOp = ILIT(238)
+tagOf_PrimOp KillThreadOp = ILIT(239)
+tagOf_PrimOp YieldOp = ILIT(240)
+tagOf_PrimOp MyThreadIdOp = ILIT(241)
+tagOf_PrimOp DelayOp = ILIT(242)
+tagOf_PrimOp WaitReadOp = ILIT(243)
+tagOf_PrimOp WaitWriteOp = ILIT(244)
+tagOf_PrimOp ParGlobalOp = ILIT(245)
+tagOf_PrimOp ParLocalOp = ILIT(246)
+tagOf_PrimOp ParAtOp = ILIT(247)
+tagOf_PrimOp ParAtAbsOp = ILIT(248)
+tagOf_PrimOp ParAtRelOp = ILIT(249)
+tagOf_PrimOp ParAtForNowOp = ILIT(250)
+tagOf_PrimOp CopyableOp = ILIT(251)
+tagOf_PrimOp NoFollowOp = ILIT(252)
+tagOf_PrimOp NewMutVarOp = ILIT(253)
+tagOf_PrimOp ReadMutVarOp = ILIT(254)
+tagOf_PrimOp WriteMutVarOp = ILIT(255)
+tagOf_PrimOp SameMutVarOp = ILIT(256)
+tagOf_PrimOp CatchOp = ILIT(257)
+tagOf_PrimOp RaiseOp = ILIT(258)
+tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(259)
+tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(260)
+tagOf_PrimOp DataToTagOp = ILIT(261)
+tagOf_PrimOp TagToEnumOp = ILIT(262)
tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
---panic# "tagOf_PrimOp: pattern-match"
instance Eq PrimOp where
op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
An @Enum@-derived list would be better; meanwhile... (ToDo)
\begin{code}
-allThePrimOps
+allThePrimOps -- Except CCall, which is really a family of primops
= [ CharGtOp,
CharGeOp,
CharEqOp,
IntMulOp,
IntQuotOp,
IntRemOp,
+ IntGcdOp,
IntNegOp,
WordQuotOp,
WordRemOp,
IntegerSubOp,
IntegerMulOp,
IntegerGcdOp,
+ IntegerIntGcdOp,
+ IntegerDivExactOp,
+ IntegerQuotOp,
+ IntegerRemOp,
IntegerQuotRemOp,
IntegerDivModOp,
IntegerNegOp,
IndexOffAddrOp StablePtrRep,
IndexOffAddrOp Int64Rep,
IndexOffAddrOp Word64Rep,
+ ReadOffAddrOp CharRep,
+ ReadOffAddrOp IntRep,
+ ReadOffAddrOp WordRep,
+ ReadOffAddrOp AddrRep,
+ ReadOffAddrOp FloatRep,
+ ReadOffAddrOp DoubleRep,
+ ReadOffAddrOp ForeignObjRep,
+ ReadOffAddrOp StablePtrRep,
+ ReadOffAddrOp Int64Rep,
+ ReadOffAddrOp Word64Rep,
WriteOffAddrOp CharRep,
WriteOffAddrOp IntRep,
WriteOffAddrOp WordRep,
UnsafeFreezeArrayOp,
UnsafeFreezeByteArrayOp,
UnsafeThawArrayOp,
- UnsafeThawByteArrayOp,
SizeofByteArrayOp,
SizeofMutableByteArrayOp,
NewMutVarOp,
SameMutVarOp,
CatchOp,
RaiseOp,
+ BlockAsyncExceptionsOp,
+ UnblockAsyncExceptionsOp,
NewMVarOp,
TakeMVarOp,
PutMVarOp,
SameMVarOp,
+ TryTakeMVarOp,
IsEmptyMVarOp,
- MakeForeignObjOp,
+ MkForeignObjOp,
WriteForeignObjOp,
MkWeakOp,
DeRefWeakOp,
= [intPrimTy, byteArrayPrimTy, -- Integer
intPrimTy]
-unboxedPair = mkUnboxedTupleTy 2
-unboxedTriple = mkUnboxedTupleTy 3
-unboxedQuadruple = mkUnboxedTupleTy 4
+unboxedSingleton = mkTupleTy Unboxed 1
+unboxedPair = mkTupleTy Unboxed 2
+unboxedTriple = mkTupleTy Unboxed 3
+unboxedQuadruple = mkTupleTy Unboxed 4
+
+mkIOTy ty = mkFunTy realWorldStatePrimTy
+ (unboxedPair [realWorldStatePrimTy,ty])
integerMonadic name = mkGenPrimOp name [] one_Integer_ty
(unboxedPair one_Integer_ty)
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 :: Arity -> PrimOp -> StrictnessInfo
+ -- See Demand.StrictnessInfo for discussion of what the results
+ -- The arity should be the arity of the primop; that's why
+ -- this function isn't exported.
+
+primOpStrictness arity SeqOp = StrictnessInfo [wwStrict] False
+ -- Seq is strict in its argument; see notes in ConFold.lhs
-primOpStrictness SeqOp = ([wwLazy], False)
-primOpStrictness ParOp = ([wwLazy], False)
-primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
+primOpStrictness arity ParOp = StrictnessInfo [wwLazy] False
+ -- Note that Par is lazy to avoid that the sparked thing
+ -- gets evaluted strictly, which it should *not* be
-primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
-primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
+primOpStrictness arity ForkOp = StrictnessInfo [wwLazy, wwPrim] False
-primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)
-primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
+primOpStrictness arity NewArrayOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
+primOpStrictness arity WriteArrayOp = StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False
-primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
+primOpStrictness arity NewMutVarOp = StrictnessInfo [wwLazy, wwPrim] False
+primOpStrictness arity WriteMutVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
-primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
-primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
+primOpStrictness arity PutMVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
-primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
-primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
-primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
+primOpStrictness arity CatchOp = StrictnessInfo [wwLazy, wwLazy, wwPrim] False
+ -- Catch is actually strict in its first argument
+ -- but we don't want to tell the strictness
+ -- analyser about that!
-primOpStrictness DataToTagOp = ([wwLazy], False)
+primOpStrictness arity RaiseOp = StrictnessInfo [wwLazy] True -- NB: True => result is bottom
+primOpStrictness arity BlockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
+primOpStrictness arity UnblockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
+
+primOpStrictness arity MkWeakOp = StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False
+primOpStrictness arity MakeStableNameOp = StrictnessInfo [wwLazy, wwPrim] False
+primOpStrictness arity MakeStablePtrOp = StrictnessInfo [wwLazy, wwPrim] False
+
+primOpStrictness arity DataToTagOp = StrictnessInfo [wwLazy] False
-- The rest all have primitive-typed arguments
-primOpStrictness other = (repeat wwPrim, False)
+primOpStrictness arity other = StrictnessInfo (replicate arity wwPrim) False
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-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 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 IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
-primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
primOpInfo IntAddCOp =
mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
+primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
+primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
+primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
+primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
primOpInfo IntegerCmpIntOp
primOpInfo IndexArrayOp
= let { elt = alphaTy; elt_tv = alphaTyVar } in
mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
- (mkUnboxedTupleTy 1 [elt])
+ (unboxedSingleton [elt])
---------------------------------------------------------------------------
-- Primitive arrays full of unboxed bytes:
in
mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
+primOpInfo (ReadOffAddrOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+ op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#")
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp op_str (s_tv:tvs)
+ [addrPrimTy, intPrimTy, state]
+ (unboxedPair [state, prim_ty])
+
primOpInfo (WriteOffAddrOp kind)
= let
s = alphaTy; s_tv = alphaTyVar
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
[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
= mkGenPrimOp
%* *
%************************************************************************
-catch :: IO a -> (IOError -> IO a) -> IO a
-catch# :: a -> (b -> a) -> a
+catch# :: (State# RealWorld -> (# State# RealWorld, a))
+ -> (b -> State# RealWorld -> (# State# RealWorld, a))
+ -> State# RealWorld
+ -> (# State# RealWorld, a)
+
+throw :: Exception -> a
+raise# :: a -> b
+
+blockAsyncExceptions# :: IO a -> IO a
+unblockAsyncExceptions# :: IO a -> IO a
\begin{code}
primOpInfo CatchOp
= let
a = alphaTy; a_tv = alphaTyVar
b = betaTy; b_tv = betaTyVar;
+ io_a = mkIOTy a
in
- mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
+ mkGenPrimOp SLIT("catch#") [a_tv, b_tv]
+ [io_a, mkFunTy b io_a, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, a])
primOpInfo RaiseOp
= let
b = betaTy; b_tv = betaTyVar;
in
mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
+
+primOpInfo BlockAsyncExceptionsOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar
+ in
+ mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
+ [ mkIOTy a, realWorldStatePrimTy ]
+ (unboxedPair [realWorldStatePrimTy,a])
+
+primOpInfo UnblockAsyncExceptionsOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar
+ in
+ mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
+ [ mkIOTy a, realWorldStatePrimTy ]
+ (unboxedPair [realWorldStatePrimTy,a])
\end{code}
%************************************************************************
in
mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
+primOpInfo TryTakeMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("tryTakeMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, state]
+ (unboxedTriple [state, intPrimTy, elt])
+
primOpInfo IsEmptyMVarOp
= let
elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
%************************************************************************
\begin{code}
-primOpInfo MakeForeignObjOp
- = mkGenPrimOp SLIT("makeForeignObj#") []
+primOpInfo MkForeignObjOp
+ = mkGenPrimOp SLIT("mkForeignObj#") []
[addrPrimTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
\begin{code}
primOpInfo MkWeakOp
- = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
- [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
+ = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
+ [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
\end{code}
%************************************************************************
%* *
-\subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
-%* *
-%************************************************************************
-
-\begin{code}
-primOpInfo (CCallOp _ _ _ _)
- = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
-
-{-
-primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
- = 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#@}
%* *
%************************************************************************
= mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
#ifdef DEBUG
-primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
+primOpInfo op = pprPanic "primOpInfo:" (ppr op)
#endif
\end{code}
\begin{code}
primOpOutOfLine op
= case op of
- 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
- FinalizeWeakOp -> True
- MakeStableNameOp -> True
- MakeForeignObjOp -> 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,
+ TakeMVarOp -> True
+ TryTakeMVarOp -> True
+ PutMVarOp -> True
+ DelayOp -> True
+ WaitReadOp -> True
+ WaitWriteOp -> True
+ CatchOp -> True
+ RaiseOp -> True
+ BlockAsyncExceptionsOp -> True
+ UnblockAsyncExceptionsOp -> True
+ NewArrayOp -> True
+ NewByteArrayOp _ -> True
+ IntegerAddOp -> True
+ IntegerSubOp -> True
+ IntegerMulOp -> True
+ IntegerGcdOp -> True
+ IntegerDivExactOp -> True
+ IntegerQuotOp -> True
+ IntegerRemOp -> True
+ IntegerQuotRemOp -> True
+ IntegerDivModOp -> True
+ Int2IntegerOp -> True
+ Word2IntegerOp -> True
+ Addr2IntegerOp -> True
+ Word64ToIntegerOp -> True
+ Int64ToIntegerOp -> True
+ FloatDecodeOp -> True
+ DoubleDecodeOp -> True
+ MkWeakOp -> True
+ FinalizeWeakOp -> True
+ MakeStableNameOp -> True
+ MkForeignObjOp -> True
+ NewMutVarOp -> True
+ NewMVarOp -> True
+ ForkOp -> True
+ KillThreadOp -> True
+ YieldOp -> True
+
+ UnsafeThawArrayOp -> True
+ -- UnsafeThawArrayOp 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
+
+ CCallOp c_call -> ccallMayGC c_call
+
+ other -> False
\end{code}
+
+primOpOkForSpeculation
+~~~~~~~~~~~~~~~~~~~~~~
Sometimes we may choose to execute a PrimOp even though it isn't
certain that its result will be required; ie execute them
``speculatively''. The same thing as ``cheap eagerness.'' Usually
this is OK, because PrimOps are usually cheap, but it isn't OK for
(a)~expensive PrimOps and (b)~PrimOps which can fail.
+PrimOps that have side effects also should not be executed speculatively.
+
+Ok-for-speculation also means that it's ok *not* to execute the
+primop. For example
+ case op a b of
+ r -> 3
+Here the result is not used, so we can discard the primop. Anything
+that has side effects mustn't be dicarded in this way, of course!
+
See also @primOpIsCheap@ (below).
-PrimOps that have side effects also should not be executed speculatively
-or by data dependencies.
\begin{code}
primOpOkForSpeculation :: PrimOp -> Bool
+ -- See comments with CoreUtils.exprOkForSpeculation
primOpOkForSpeculation op
= not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
\end{code}
+
+primOpIsCheap
+~~~~~~~~~~~~~
@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 :: PrimOp -> Bool
+ -- See comments with CoreUtils.exprOkForSpeculation
primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
\end{code}
+primOpIsDupable
+~~~~~~~~~~~~~~~
primOpIsDupable means that the use of the primop is small enough to
duplicate into different case branches. See CoreUtils.exprIsDupable.
\begin{code}
-primOpIsDupable (CCallOp _ _ _ _) = False
-primOpIsDupable op = not (primOpOutOfLine op)
+primOpIsDupable :: PrimOp -> Bool
+ -- See comments with CoreUtils.exprIsDupable
+ -- We say it's dupable it isn't implemented by a C call with a wrapper
+primOpIsDupable op = not (primOpNeedsWrapper op)
\end{code}
\begin{code}
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 YieldOp = True
primOpHasSideEffects SeqOp = True
-primOpHasSideEffects MakeForeignObjOp = True
+primOpHasSideEffects MkForeignObjOp = True
primOpHasSideEffects WriteForeignObjOp = True
primOpHasSideEffects MkWeakOp = True
primOpHasSideEffects DeRefWeakOp = True
primOpHasSideEffects EqStablePtrOp = True -- SOF
primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
+-- In general, writes are considered a side effect, but
+-- reads and variable allocations are not
+-- Why? Because writes must not be omitted, but reads can be if their result is not used.
+-- (Sequencing of reads is maintained by data dependencies on the resulting
+-- world state.)
+primOpHasSideEffects WriteArrayOp = True
+primOpHasSideEffects (WriteByteArrayOp _) = True
+primOpHasSideEffects (WriteOffAddrOp _) = True
+primOpHasSideEffects WriteMutVarOp = True
+
+primOpHasSideEffects UnsafeFreezeArrayOp = True
+primOpHasSideEffects UnsafeFreezeByteArrayOp = True
+primOpHasSideEffects UnsafeThawArrayOp = True
+
+primOpHasSideEffects TakeMVarOp = True
+primOpHasSideEffects TryTakeMVarOp = True
+primOpHasSideEffects PutMVarOp = True
+primOpHasSideEffects DelayOp = True
+primOpHasSideEffects WaitReadOp = True
+primOpHasSideEffects WaitWriteOp = True
+
primOpHasSideEffects ParGlobalOp = True
primOpHasSideEffects ParLocalOp = True
primOpHasSideEffects ParAtOp = True
primOpHasSideEffects ParAtForNowOp = True
primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
-
--- CCall
-primOpHasSideEffects (CCallOp _ _ _ _) = True
+primOpHasSideEffects (CCallOp _) = True
primOpHasSideEffects other = False
\end{code}
\begin{code}
primOpNeedsWrapper :: PrimOp -> Bool
-primOpNeedsWrapper (CCallOp _ _ _ _) = True
+primOpNeedsWrapper (CCallOp _) = True
primOpNeedsWrapper Integer2IntOp = True
primOpNeedsWrapper Integer2WordOp = True
\end{code}
\begin{code}
+primOpArity :: PrimOp -> Arity
+primOpArity op
+ = case (primOpInfo op) of
+ Monadic occ ty -> 1
+ Dyadic occ ty -> 2
+ Compare occ ty -> 2
+ GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
+
primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
primOpType op
= case (primOpInfo op) of
= mkWiredInIdName key pREL_GHC occ_name id
where
occ_name = primOpOcc op
- key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
+ key = mkPrimOpIdUnique (primOpTag op)
primOpRdrName :: PrimOp -> RdrName
-- primOpSig is like primOpType but gives the result split apart:
-- (type variables, argument types, result type)
+-- It also gives arity, strictness info
-primOpSig :: PrimOp -> ([TyVar],[Type],Type)
+primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
primOpSig op
- = case (primOpInfo op) of
- 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)
+ = (tyvars, arg_tys, res_ty, arity, primOpStrictness arity op)
+ where
+ arity = length arg_tys
+ (tyvars, arg_tys, res_ty)
+ = case (primOpInfo op) of
+ Monadic occ ty -> ([], [ty], ty )
+ Dyadic occ ty -> ([], [ty,ty], ty )
+ Compare occ ty -> ([], [ty,ty], 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,
SameMutVarOp -> mangle [mkP, mkP ] mkM
CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
- mangle [mkM, mkM . (inFun mkM mkM)] mkM
+ mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM
-- might use caught action multiply
RaiseOp -> mangle [mkM ] mkM
TakeMVarOp -> mangle [mkM, mkP ] mkM
PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
SameMVarOp -> mangle [mkP, mkP ] mkM
+ TryTakeMVarOp -> mangle [mkM, mkP ] mkM
IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
ForkOp -> mangle [mkO, mkP ] mkR
CopyableOp -> mangle [mkZ ] mkR
NoFollowOp -> mangle [mkZ ] mkR
- CCallOp _ _ _ _ -> mangle [ ] mkM
+ CCallOp _ -> mangle [ ] mkM
-- Things with no Haskell pointers inside: in actuality, usages are
-- irrelevant here (hence it doesn't matter that some of these
mkP = mkUsgTy UsOnce -- unpointed argument
mkR = mkUsgTy UsMany -- unpointed result
- (tyvars, arg_tys, res_ty)
- = primOpSig op
+ (tyvars, arg_tys, res_ty, _, _) = primOpSig op
nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
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"
+ Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
+ mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg"
($) fs tys)
Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
\end{code}
-- be out of line, or the code generator won't work.
getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
+getPrimOpResultInfo (CCallOp _)
+ = ReturnsAlg unboxedPairTyCon
getPrimOpResultInfo op
= case (primOpInfo op) of
Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
Nothing -> panic "getPrimOpResultInfo"
Just (tc,_,_) -> ReturnsAlg tc
other -> ReturnsPrim other
-
-isCompareOp :: PrimOp -> Bool
-isCompareOp op
- = case primOpInfo op of
- Compare _ _ -> True
- _ -> False
\end{code}
The commutable ops are those for which we will try to move constants
commutableOp IntegerAddOp = True
commutableOp IntegerMulOp = True
commutableOp IntegerGcdOp = True
+commutableOp IntegerIntGcdOp = True
commutableOp FloatAddOp = True
commutableOp FloatMulOp = True
commutableOp FloatEqOp = True
\begin{code}
pprPrimOp :: PrimOp -> SDoc
-pprPrimOp (CCallOp fun is_casm may_gc cconv)
- = let
+pprPrimOp (CCallOp c_call) = pprCCallOp c_call
+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}
+
+
+%************************************************************************
+%* *
+\subsubsection{CCalls}
+%* *
+%************************************************************************
+
+A special ``trap-door'' to use in making calls direct to C functions:
+\begin{code}
+data CCall
+ = CCall CCallTarget
+ Bool -- True <=> really a "casm"
+ Bool -- True <=> might invoke Haskell GC
+ CallConv -- calling convention to use.
+ deriving( Eq )
+
+data CCallTarget
+ = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
+ | DynamicTarget Unique -- 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.)
+
+instance Eq CCallTarget where
+ (StaticTarget l1) == (StaticTarget l2) = l1 == l2
+ (DynamicTarget _) == (DynamicTarget _) = True
+ -- Ignore the arbitrary unique; this is important when comparing
+ -- a dynamic ccall read from an interface file A.hi with the
+ -- one constructed from A.hs, when deciding whether the interface
+ -- has changed
+ t1 == t2 = False
+
+ccallMayGC :: CCall -> Bool
+ccallMayGC (CCall _ _ may_gc _) = may_gc
+
+ccallIsCasm :: CCall -> Bool
+ccallIsCasm (CCall _ c_asm _ _) = c_asm
+
+isDynamicTarget (DynamicTarget _) = True
+isDynamicTarget (StaticTarget _) = False
+
+dynamicTarget :: CCallTarget
+dynamicTarget = DynamicTarget (panic "Unique in DynamicTarget not yet set")
+ -- The unique is really only to do with code generation, so it
+ -- is only set in CoreToStg; before then it's just an error message
+
+setCCallUnique :: CCall -> Unique -> CCall
+setCCallUnique (CCall (DynamicTarget _) is_asm may_gc cconv) uniq
+ = CCall (DynamicTarget uniq) is_asm may_gc cconv
+setCCallUnique ccall uniq = ccall
+\end{code}
+
+\begin{code}
+pprCCallOp (CCall fun is_casm may_gc cconv)
+ = hcat [ ifPprDebug callconv
+ , text "__", ppr_dyn
+ , text before , ppr_fun , after]
+ where
callconv = text "{-" <> pprCallConv cconv <> text "-}"
before
| is_casm = text "''"
| otherwise = empty
- ppr_dyn =
- case fun of
- Right _ -> text "dyn_"
- _ -> empty
-
- ppr_fun =
- case fun of
- Right _ -> text "\"\""
- Left fn -> ptext fn
-
- in
- hcat [ ifPprDebug callconv
- , text "__", ppr_dyn
- , text before , ppr_fun , after]
+ ppr_dyn = case fun of
+ DynamicTarget _ -> text "dyn_"
+ _ -> empty
-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
+ ppr_fun = case fun of
+ DynamicTarget _ -> text "\"\""
+ StaticTarget fn -> pprCLabelString fn
\end{code}
projects / ghc-hetmet.git / blobdiff