-%\r
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\r
-%\r
-\section[PrimOp]{Primitive operations (machine-level)}\r
-\r
-\begin{code}\r
-module PrimOp (\r
- PrimOp(..), allThePrimOps,\r
- primOpType, primOpSig, primOpUsg,\r
- mkPrimOpIdName, primOpRdrName,\r
-\r
- commutableOp,\r
-\r
- primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,\r
- primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,\r
- primOpHasSideEffects,\r
-\r
- getPrimOpResultInfo, PrimOpResultInfo(..),\r
-\r
- pprPrimOp\r
- ) where\r
-\r
-#include "HsVersions.h"\r
-\r
-import PrimRep -- most of it\r
-import TysPrim\r
-import TysWiredIn\r
-\r
-import Demand ( Demand, wwLazy, wwPrim, wwStrict )\r
-import Var ( TyVar, Id )\r
-import CallConv ( CallConv, pprCallConv )\r
-import PprType ( pprParendType )\r
-import Name ( Name, mkWiredInIdName )\r
-import RdrName ( RdrName, mkRdrQual )\r
-import OccName ( OccName, pprOccName, mkSrcVarOcc )\r
-import TyCon ( TyCon, tyConArity )\r
-import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,\r
- mkTyConTy, mkTyConApp, typePrimRep,\r
- splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,\r
- UsageAnn(..), mkUsgTy\r
- )\r
-import Unique ( Unique, mkPrimOpIdUnique )\r
-import PrelMods ( pREL_GHC, pREL_GHC_Name )\r
-import Outputable\r
-import Util ( assoc, zipWithEqual )\r
-import GlaExts ( Int(..), Int#, (==#) )\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}\r
-%* *\r
-%************************************************************************\r
-\r
-These are in \tr{state-interface.verb} order.\r
-\r
-\begin{code}\r
-data PrimOp\r
- -- dig the FORTRAN/C influence on the names...\r
-\r
- -- comparisons:\r
-\r
- = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp\r
- | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp\r
- | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp\r
- | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp\r
- | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp\r
- | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp\r
-\r
- -- Char#-related ops:\r
- | OrdOp | ChrOp\r
-\r
- -- Int#-related ops:\r
- -- IntAbsOp unused?? ADR\r
- | IntAddOp | IntSubOp | IntMulOp | IntQuotOp\r
- | IntRemOp | IntNegOp | IntAbsOp\r
- | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}\r
- | IntAddCOp\r
- | IntSubCOp\r
- | IntMulCOp\r
-\r
- -- Word#-related ops:\r
- | WordQuotOp | WordRemOp\r
- | AndOp | OrOp | NotOp | XorOp\r
- | SllOp | SrlOp -- shift {left,right} {logical}\r
- | Int2WordOp | Word2IntOp -- casts\r
-\r
- -- Addr#-related ops:\r
- | Int2AddrOp | Addr2IntOp -- casts\r
-\r
- -- Float#-related ops:\r
- | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp\r
- | Float2IntOp | Int2FloatOp\r
-\r
- | FloatExpOp | FloatLogOp | FloatSqrtOp\r
- | FloatSinOp | FloatCosOp | FloatTanOp\r
- | FloatAsinOp | FloatAcosOp | FloatAtanOp\r
- | FloatSinhOp | FloatCoshOp | FloatTanhOp\r
- -- not all machines have these available conveniently:\r
- -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp\r
- | FloatPowerOp -- ** op\r
-\r
- -- Double#-related ops:\r
- | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp\r
- | Double2IntOp | Int2DoubleOp\r
- | Double2FloatOp | Float2DoubleOp\r
-\r
- | DoubleExpOp | DoubleLogOp | DoubleSqrtOp\r
- | DoubleSinOp | DoubleCosOp | DoubleTanOp\r
- | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp\r
- | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp\r
- -- not all machines have these available conveniently:\r
- -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp\r
- | DoublePowerOp -- ** op\r
-\r
- -- Integer (and related...) ops:\r
- -- slightly weird -- to match GMP package.\r
- | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp\r
- | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp\r
-\r
- | IntegerCmpOp\r
- | IntegerCmpIntOp\r
-\r
- | Integer2IntOp | Integer2WordOp \r
- | Int2IntegerOp | Word2IntegerOp\r
- | Addr2IntegerOp\r
- -- casting to/from Integer and 64-bit (un)signed quantities.\r
- | IntegerToInt64Op | Int64ToIntegerOp\r
- | IntegerToWord64Op | Word64ToIntegerOp\r
- -- ?? gcd, etc?\r
-\r
- | FloatDecodeOp\r
- | DoubleDecodeOp\r
-\r
- -- primitive ops for primitive arrays\r
-\r
- | NewArrayOp\r
- | NewByteArrayOp PrimRep\r
-\r
- | SameMutableArrayOp\r
- | SameMutableByteArrayOp\r
-\r
- | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs\r
-\r
- | ReadByteArrayOp PrimRep\r
- | WriteByteArrayOp PrimRep\r
- | IndexByteArrayOp PrimRep\r
- | IndexOffAddrOp PrimRep\r
- | WriteOffAddrOp PrimRep\r
- -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.\r
- -- This is just a cheesy encoding of a bunch of ops.\r
- -- Note that ForeignObjRep is not included -- the only way of\r
- -- creating a ForeignObj is with a ccall or casm.\r
- | IndexOffForeignObjOp PrimRep\r
-\r
- | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp\r
- | UnsafeThawArrayOp | UnsafeThawByteArrayOp\r
- | SizeofByteArrayOp | SizeofMutableByteArrayOp\r
-\r
- -- Mutable variables\r
- | NewMutVarOp\r
- | ReadMutVarOp\r
- | WriteMutVarOp\r
- | SameMutVarOp\r
-\r
- -- for MVars\r
- | NewMVarOp\r
- | TakeMVarOp \r
- | PutMVarOp\r
- | SameMVarOp\r
- | IsEmptyMVarOp\r
-\r
- -- exceptions\r
- | CatchOp\r
- | RaiseOp\r
-\r
- -- foreign objects\r
- | MakeForeignObjOp\r
- | WriteForeignObjOp\r
-\r
- -- weak pointers\r
- | MkWeakOp\r
- | DeRefWeakOp\r
- | FinalizeWeakOp\r
-\r
- -- stable names\r
- | MakeStableNameOp\r
- | EqStableNameOp\r
- | StableNameToIntOp\r
-\r
- -- stable pointers\r
- | MakeStablePtrOp\r
- | DeRefStablePtrOp\r
- | EqStablePtrOp\r
-\end{code}\r
-\r
-A special ``trap-door'' to use in making calls direct to C functions:\r
-\begin{code}\r
- | CCallOp (Either \r
- FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.\r
- Unique) -- Right u => first argument (an Addr#) is the function pointer\r
- -- (unique is used to generate a 'typedef' to cast\r
- -- the function pointer if compiling the ccall# down to\r
- -- .hc code - can't do this inline for tedious reasons.)\r
- \r
- Bool -- True <=> really a "casm"\r
- Bool -- True <=> might invoke Haskell GC\r
- CallConv -- calling convention to use.\r
-\r
- -- (... to be continued ... )\r
-\end{code}\r
-\r
-The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.\r
-(See @primOpInfo@ for details.)\r
-\r
-Note: that first arg and part of the result should be the system state\r
-token (which we carry around to fool over-zealous optimisers) but\r
-which isn't actually passed.\r
-\r
-For example, we represent\r
-\begin{pseudocode}\r
-((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)\r
-\end{pseudocode}\r
-by\r
-\begin{pseudocode}\r
-Case\r
- ( Prim\r
- (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)\r
- -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse\r
- []\r
- [w#, sp# i#]\r
- )\r
- (AlgAlts [ ( FloatPrimAndIoWorld,\r
- [f#, w#],\r
- Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]\r
- ) ]\r
- NoDefault\r
- )\r
-\end{pseudocode}\r
-\r
-Nota Bene: there are some people who find the empty list of types in\r
-the @Prim@ somewhat puzzling and would represent the above by\r
-\begin{pseudocode}\r
-Case\r
- ( Prim\r
- (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)\r
- -- :: /\ alpha1, alpha2 alpha3, alpha4.\r
- -- alpha1 -> alpha2 -> alpha3 -> alpha4\r
- [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]\r
- [w#, sp# i#]\r
- )\r
- (AlgAlts [ ( FloatPrimAndIoWorld,\r
- [f#, w#],\r
- Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]\r
- ) ]\r
- NoDefault\r
- )\r
-\end{pseudocode}\r
-\r
-But, this is a completely different way of using @CCallOp@. The most\r
-major changes required if we switch to this are in @primOpInfo@, and\r
-the desugarer. The major difficulty is in moving the HeapRequirement\r
-stuff somewhere appropriate. (The advantage is that we could simplify\r
-@CCallOp@ and record just the number of arguments with corresponding\r
-simplifications in reading pragma unfoldings, the simplifier,\r
-instantiation (etc) of core expressions, ... . Maybe we should think\r
-about using it this way?? ADR)\r
-\r
-\begin{code}\r
- -- (... continued from above ... )\r
-\r
- -- Operation to test two closure addresses for equality (yes really!)\r
- -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!\r
- | ReallyUnsafePtrEqualityOp\r
-\r
- -- parallel stuff\r
- | SeqOp\r
- | ParOp\r
-\r
- -- concurrency\r
- | ForkOp\r
- | KillThreadOp\r
- | YieldOp\r
- | MyThreadIdOp\r
- | DelayOp\r
- | WaitReadOp\r
- | WaitWriteOp\r
-\r
- -- more parallel stuff\r
- | ParGlobalOp -- named global par\r
- | ParLocalOp -- named local par\r
- | ParAtOp -- specifies destination of local par\r
- | ParAtAbsOp -- specifies destination of local par (abs processor)\r
- | ParAtRelOp -- specifies destination of local par (rel processor)\r
- | ParAtForNowOp -- specifies initial destination of global par\r
- | CopyableOp -- marks copyable code\r
- | NoFollowOp -- marks non-followup expression\r
-\r
- -- tag-related\r
- | DataToTagOp\r
- | TagToEnumOp\r
-\end{code}\r
-\r
-Used for the Ord instance\r
-\r
-\begin{code}\r
-tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)\r
-tagOf_PrimOp CharGeOp = ILIT( 2)\r
-tagOf_PrimOp CharEqOp = ILIT( 3)\r
-tagOf_PrimOp CharNeOp = ILIT( 4)\r
-tagOf_PrimOp CharLtOp = ILIT( 5)\r
-tagOf_PrimOp CharLeOp = ILIT( 6)\r
-tagOf_PrimOp IntGtOp = ILIT( 7)\r
-tagOf_PrimOp IntGeOp = ILIT( 8)\r
-tagOf_PrimOp IntEqOp = ILIT( 9)\r
-tagOf_PrimOp IntNeOp = ILIT( 10)\r
-tagOf_PrimOp IntLtOp = ILIT( 11)\r
-tagOf_PrimOp IntLeOp = ILIT( 12)\r
-tagOf_PrimOp WordGtOp = ILIT( 13)\r
-tagOf_PrimOp WordGeOp = ILIT( 14)\r
-tagOf_PrimOp WordEqOp = ILIT( 15)\r
-tagOf_PrimOp WordNeOp = ILIT( 16)\r
-tagOf_PrimOp WordLtOp = ILIT( 17)\r
-tagOf_PrimOp WordLeOp = ILIT( 18)\r
-tagOf_PrimOp AddrGtOp = ILIT( 19)\r
-tagOf_PrimOp AddrGeOp = ILIT( 20)\r
-tagOf_PrimOp AddrEqOp = ILIT( 21)\r
-tagOf_PrimOp AddrNeOp = ILIT( 22)\r
-tagOf_PrimOp AddrLtOp = ILIT( 23)\r
-tagOf_PrimOp AddrLeOp = ILIT( 24)\r
-tagOf_PrimOp FloatGtOp = ILIT( 25)\r
-tagOf_PrimOp FloatGeOp = ILIT( 26)\r
-tagOf_PrimOp FloatEqOp = ILIT( 27)\r
-tagOf_PrimOp FloatNeOp = ILIT( 28)\r
-tagOf_PrimOp FloatLtOp = ILIT( 29)\r
-tagOf_PrimOp FloatLeOp = ILIT( 30)\r
-tagOf_PrimOp DoubleGtOp = ILIT( 31)\r
-tagOf_PrimOp DoubleGeOp = ILIT( 32)\r
-tagOf_PrimOp DoubleEqOp = ILIT( 33)\r
-tagOf_PrimOp DoubleNeOp = ILIT( 34)\r
-tagOf_PrimOp DoubleLtOp = ILIT( 35)\r
-tagOf_PrimOp DoubleLeOp = ILIT( 36)\r
-tagOf_PrimOp OrdOp = ILIT( 37)\r
-tagOf_PrimOp ChrOp = ILIT( 38)\r
-tagOf_PrimOp IntAddOp = ILIT( 39)\r
-tagOf_PrimOp IntSubOp = ILIT( 40)\r
-tagOf_PrimOp IntMulOp = ILIT( 41)\r
-tagOf_PrimOp IntQuotOp = ILIT( 42)\r
-tagOf_PrimOp IntRemOp = ILIT( 43)\r
-tagOf_PrimOp IntNegOp = ILIT( 44)\r
-tagOf_PrimOp IntAbsOp = ILIT( 45)\r
-tagOf_PrimOp WordQuotOp = ILIT( 46)\r
-tagOf_PrimOp WordRemOp = ILIT( 47)\r
-tagOf_PrimOp AndOp = ILIT( 48)\r
-tagOf_PrimOp OrOp = ILIT( 49)\r
-tagOf_PrimOp NotOp = ILIT( 50)\r
-tagOf_PrimOp XorOp = ILIT( 51)\r
-tagOf_PrimOp SllOp = ILIT( 52)\r
-tagOf_PrimOp SrlOp = ILIT( 53)\r
-tagOf_PrimOp ISllOp = ILIT( 54)\r
-tagOf_PrimOp ISraOp = ILIT( 55)\r
-tagOf_PrimOp ISrlOp = ILIT( 56)\r
-tagOf_PrimOp IntAddCOp = ILIT( 57)\r
-tagOf_PrimOp IntSubCOp = ILIT( 58)\r
-tagOf_PrimOp IntMulCOp = ILIT( 59)\r
-tagOf_PrimOp Int2WordOp = ILIT( 60)\r
-tagOf_PrimOp Word2IntOp = ILIT( 61)\r
-tagOf_PrimOp Int2AddrOp = ILIT( 62)\r
-tagOf_PrimOp Addr2IntOp = ILIT( 63)\r
-\r
-tagOf_PrimOp FloatAddOp = ILIT( 64)\r
-tagOf_PrimOp FloatSubOp = ILIT( 65)\r
-tagOf_PrimOp FloatMulOp = ILIT( 66)\r
-tagOf_PrimOp FloatDivOp = ILIT( 67)\r
-tagOf_PrimOp FloatNegOp = ILIT( 68)\r
-tagOf_PrimOp Float2IntOp = ILIT( 69)\r
-tagOf_PrimOp Int2FloatOp = ILIT( 70)\r
-tagOf_PrimOp FloatExpOp = ILIT( 71)\r
-tagOf_PrimOp FloatLogOp = ILIT( 72)\r
-tagOf_PrimOp FloatSqrtOp = ILIT( 73)\r
-tagOf_PrimOp FloatSinOp = ILIT( 74)\r
-tagOf_PrimOp FloatCosOp = ILIT( 75)\r
-tagOf_PrimOp FloatTanOp = ILIT( 76)\r
-tagOf_PrimOp FloatAsinOp = ILIT( 77)\r
-tagOf_PrimOp FloatAcosOp = ILIT( 78)\r
-tagOf_PrimOp FloatAtanOp = ILIT( 79)\r
-tagOf_PrimOp FloatSinhOp = ILIT( 80)\r
-tagOf_PrimOp FloatCoshOp = ILIT( 81)\r
-tagOf_PrimOp FloatTanhOp = ILIT( 82)\r
-tagOf_PrimOp FloatPowerOp = ILIT( 83)\r
-\r
-tagOf_PrimOp DoubleAddOp = ILIT( 84)\r
-tagOf_PrimOp DoubleSubOp = ILIT( 85)\r
-tagOf_PrimOp DoubleMulOp = ILIT( 86)\r
-tagOf_PrimOp DoubleDivOp = ILIT( 87)\r
-tagOf_PrimOp DoubleNegOp = ILIT( 88)\r
-tagOf_PrimOp Double2IntOp = ILIT( 89)\r
-tagOf_PrimOp Int2DoubleOp = ILIT( 90)\r
-tagOf_PrimOp Double2FloatOp = ILIT( 91)\r
-tagOf_PrimOp Float2DoubleOp = ILIT( 92)\r
-tagOf_PrimOp DoubleExpOp = ILIT( 93)\r
-tagOf_PrimOp DoubleLogOp = ILIT( 94)\r
-tagOf_PrimOp DoubleSqrtOp = ILIT( 95)\r
-tagOf_PrimOp DoubleSinOp = ILIT( 96)\r
-tagOf_PrimOp DoubleCosOp = ILIT( 97)\r
-tagOf_PrimOp DoubleTanOp = ILIT( 98)\r
-tagOf_PrimOp DoubleAsinOp = ILIT( 99)\r
-tagOf_PrimOp DoubleAcosOp = ILIT(100)\r
-tagOf_PrimOp DoubleAtanOp = ILIT(101)\r
-tagOf_PrimOp DoubleSinhOp = ILIT(102)\r
-tagOf_PrimOp DoubleCoshOp = ILIT(103)\r
-tagOf_PrimOp DoubleTanhOp = ILIT(104)\r
-tagOf_PrimOp DoublePowerOp = ILIT(105)\r
-\r
-tagOf_PrimOp IntegerAddOp = ILIT(106)\r
-tagOf_PrimOp IntegerSubOp = ILIT(107)\r
-tagOf_PrimOp IntegerMulOp = ILIT(108)\r
-tagOf_PrimOp IntegerGcdOp = ILIT(109)\r
-tagOf_PrimOp IntegerQuotRemOp = ILIT(110)\r
-tagOf_PrimOp IntegerDivModOp = ILIT(111)\r
-tagOf_PrimOp IntegerNegOp = ILIT(112)\r
-tagOf_PrimOp IntegerCmpOp = ILIT(113)\r
-tagOf_PrimOp IntegerCmpIntOp = ILIT(114)\r
-tagOf_PrimOp Integer2IntOp = ILIT(115)\r
-tagOf_PrimOp Integer2WordOp = ILIT(116)\r
-tagOf_PrimOp Int2IntegerOp = ILIT(117)\r
-tagOf_PrimOp Word2IntegerOp = ILIT(118)\r
-tagOf_PrimOp Addr2IntegerOp = ILIT(119)\r
-tagOf_PrimOp IntegerToInt64Op = ILIT(120)\r
-tagOf_PrimOp Int64ToIntegerOp = ILIT(121)\r
-tagOf_PrimOp IntegerToWord64Op = ILIT(122)\r
-tagOf_PrimOp Word64ToIntegerOp = ILIT(123)\r
-tagOf_PrimOp FloatDecodeOp = ILIT(125)\r
-tagOf_PrimOp DoubleDecodeOp = ILIT(127)\r
-\r
-tagOf_PrimOp NewArrayOp = ILIT(128)\r
-tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129)\r
-tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130)\r
-tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131)\r
-tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132)\r
-tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133)\r
-tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134)\r
-tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135)\r
-\r
-tagOf_PrimOp SameMutableArrayOp = ILIT(136)\r
-tagOf_PrimOp SameMutableByteArrayOp = ILIT(137)\r
-tagOf_PrimOp ReadArrayOp = ILIT(138)\r
-tagOf_PrimOp WriteArrayOp = ILIT(139)\r
-tagOf_PrimOp IndexArrayOp = ILIT(140)\r
-\r
-tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141)\r
-tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142)\r
-tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143)\r
-tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144)\r
-tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145)\r
-tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146)\r
-tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147)\r
-tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148)\r
-tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149)\r
-\r
-tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150)\r
-tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151)\r
-tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152)\r
-tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153)\r
-tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154)\r
-tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155)\r
-tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156)\r
-tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157)\r
-tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158)\r
-\r
-tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159)\r
-tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160)\r
-tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161)\r
-tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162)\r
-tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163)\r
-tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164)\r
-tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165)\r
-tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166)\r
-tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167)\r
-\r
-tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168)\r
-tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169)\r
-tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170)\r
-tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171)\r
-tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172)\r
-tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173)\r
-tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174)\r
-tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175)\r
-tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176)\r
-\r
-tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177)\r
-tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178)\r
-tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179)\r
-tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180)\r
-tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181)\r
-tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)\r
-tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)\r
-tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184)\r
-tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)\r
-\r
-tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186)\r
-tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187)\r
-tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188)\r
-tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189)\r
-tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190)\r
-tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191)\r
-tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192)\r
-tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193)\r
-tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194)\r
-tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)\r
-\r
-tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)\r
-tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)\r
-tagOf_PrimOp UnsafeThawArrayOp = ILIT(198)\r
-tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199)\r
-tagOf_PrimOp SizeofByteArrayOp = ILIT(200)\r
-tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201)\r
-\r
-tagOf_PrimOp NewMVarOp = ILIT(202)\r
-tagOf_PrimOp TakeMVarOp = ILIT(203)\r
-tagOf_PrimOp PutMVarOp = ILIT(204)\r
-tagOf_PrimOp SameMVarOp = ILIT(205)\r
-tagOf_PrimOp IsEmptyMVarOp = ILIT(206)\r
-tagOf_PrimOp MakeForeignObjOp = ILIT(207)\r
-tagOf_PrimOp WriteForeignObjOp = ILIT(208)\r
-tagOf_PrimOp MkWeakOp = ILIT(209)\r
-tagOf_PrimOp DeRefWeakOp = ILIT(210)\r
-tagOf_PrimOp FinalizeWeakOp = ILIT(211)\r
-tagOf_PrimOp MakeStableNameOp = ILIT(212)\r
-tagOf_PrimOp EqStableNameOp = ILIT(213)\r
-tagOf_PrimOp StableNameToIntOp = ILIT(214)\r
-tagOf_PrimOp MakeStablePtrOp = ILIT(215)\r
-tagOf_PrimOp DeRefStablePtrOp = ILIT(216)\r
-tagOf_PrimOp EqStablePtrOp = ILIT(217)\r
-tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218)\r
-tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219)\r
-tagOf_PrimOp SeqOp = ILIT(220)\r
-tagOf_PrimOp ParOp = ILIT(221)\r
-tagOf_PrimOp ForkOp = ILIT(222)\r
-tagOf_PrimOp KillThreadOp = ILIT(223)\r
-tagOf_PrimOp YieldOp = ILIT(224)\r
-tagOf_PrimOp MyThreadIdOp = ILIT(225)\r
-tagOf_PrimOp DelayOp = ILIT(226)\r
-tagOf_PrimOp WaitReadOp = ILIT(227)\r
-tagOf_PrimOp WaitWriteOp = ILIT(228)\r
-tagOf_PrimOp ParGlobalOp = ILIT(229)\r
-tagOf_PrimOp ParLocalOp = ILIT(230)\r
-tagOf_PrimOp ParAtOp = ILIT(231)\r
-tagOf_PrimOp ParAtAbsOp = ILIT(232)\r
-tagOf_PrimOp ParAtRelOp = ILIT(233)\r
-tagOf_PrimOp ParAtForNowOp = ILIT(234)\r
-tagOf_PrimOp CopyableOp = ILIT(235)\r
-tagOf_PrimOp NoFollowOp = ILIT(236)\r
-tagOf_PrimOp NewMutVarOp = ILIT(237)\r
-tagOf_PrimOp ReadMutVarOp = ILIT(238)\r
-tagOf_PrimOp WriteMutVarOp = ILIT(239)\r
-tagOf_PrimOp SameMutVarOp = ILIT(240)\r
-tagOf_PrimOp CatchOp = ILIT(241)\r
-tagOf_PrimOp RaiseOp = ILIT(242)\r
-tagOf_PrimOp DataToTagOp = ILIT(243)\r
-tagOf_PrimOp TagToEnumOp = ILIT(244)\r
-\r
-tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)\r
---panic# "tagOf_PrimOp: pattern-match"\r
-\r
-instance Eq PrimOp where\r
- op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2\r
-\r
-instance Ord PrimOp where\r
- op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2\r
- op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2\r
- op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2\r
- op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2\r
- op1 `compare` op2 | op1 < op2 = LT\r
- | op1 == op2 = EQ\r
- | otherwise = GT\r
-\r
-instance Outputable PrimOp where\r
- ppr op = pprPrimOp op\r
-\r
-instance Show PrimOp where\r
- showsPrec p op = showsPrecSDoc p (pprPrimOp op)\r
-\end{code}\r
-\r
-An @Enum@-derived list would be better; meanwhile... (ToDo)\r
-\begin{code}\r
-allThePrimOps\r
- = [ CharGtOp,\r
- CharGeOp,\r
- CharEqOp,\r
- CharNeOp,\r
- CharLtOp,\r
- CharLeOp,\r
- IntGtOp,\r
- IntGeOp,\r
- IntEqOp,\r
- IntNeOp,\r
- IntLtOp,\r
- IntLeOp,\r
- WordGtOp,\r
- WordGeOp,\r
- WordEqOp,\r
- WordNeOp,\r
- WordLtOp,\r
- WordLeOp,\r
- AddrGtOp,\r
- AddrGeOp,\r
- AddrEqOp,\r
- AddrNeOp,\r
- AddrLtOp,\r
- AddrLeOp,\r
- FloatGtOp,\r
- FloatGeOp,\r
- FloatEqOp,\r
- FloatNeOp,\r
- FloatLtOp,\r
- FloatLeOp,\r
- DoubleGtOp,\r
- DoubleGeOp,\r
- DoubleEqOp,\r
- DoubleNeOp,\r
- DoubleLtOp,\r
- DoubleLeOp,\r
- OrdOp,\r
- ChrOp,\r
- IntAddOp,\r
- IntSubOp,\r
- IntMulOp,\r
- IntQuotOp,\r
- IntRemOp,\r
- IntNegOp,\r
- WordQuotOp,\r
- WordRemOp,\r
- AndOp,\r
- OrOp,\r
- NotOp,\r
- XorOp,\r
- SllOp,\r
- SrlOp,\r
- ISllOp,\r
- ISraOp,\r
- ISrlOp,\r
- IntAddCOp,\r
- IntSubCOp,\r
- IntMulCOp,\r
- Int2WordOp,\r
- Word2IntOp,\r
- Int2AddrOp,\r
- Addr2IntOp,\r
-\r
- FloatAddOp,\r
- FloatSubOp,\r
- FloatMulOp,\r
- FloatDivOp,\r
- FloatNegOp,\r
- Float2IntOp,\r
- Int2FloatOp,\r
- FloatExpOp,\r
- FloatLogOp,\r
- FloatSqrtOp,\r
- FloatSinOp,\r
- FloatCosOp,\r
- FloatTanOp,\r
- FloatAsinOp,\r
- FloatAcosOp,\r
- FloatAtanOp,\r
- FloatSinhOp,\r
- FloatCoshOp,\r
- FloatTanhOp,\r
- FloatPowerOp,\r
- DoubleAddOp,\r
- DoubleSubOp,\r
- DoubleMulOp,\r
- DoubleDivOp,\r
- DoubleNegOp,\r
- Double2IntOp,\r
- Int2DoubleOp,\r
- Double2FloatOp,\r
- Float2DoubleOp,\r
- DoubleExpOp,\r
- DoubleLogOp,\r
- DoubleSqrtOp,\r
- DoubleSinOp,\r
- DoubleCosOp,\r
- DoubleTanOp,\r
- DoubleAsinOp,\r
- DoubleAcosOp,\r
- DoubleAtanOp,\r
- DoubleSinhOp,\r
- DoubleCoshOp,\r
- DoubleTanhOp,\r
- DoublePowerOp,\r
- IntegerAddOp,\r
- IntegerSubOp,\r
- IntegerMulOp,\r
- IntegerGcdOp,\r
- IntegerQuotRemOp,\r
- IntegerDivModOp,\r
- IntegerNegOp,\r
- IntegerCmpOp,\r
- IntegerCmpIntOp,\r
- Integer2IntOp,\r
- Integer2WordOp,\r
- Int2IntegerOp,\r
- Word2IntegerOp,\r
- Addr2IntegerOp,\r
- IntegerToInt64Op,\r
- Int64ToIntegerOp,\r
- IntegerToWord64Op,\r
- Word64ToIntegerOp,\r
- FloatDecodeOp,\r
- DoubleDecodeOp,\r
- NewArrayOp,\r
- NewByteArrayOp CharRep,\r
- NewByteArrayOp IntRep,\r
- NewByteArrayOp WordRep,\r
- NewByteArrayOp AddrRep,\r
- NewByteArrayOp FloatRep,\r
- NewByteArrayOp DoubleRep,\r
- NewByteArrayOp StablePtrRep,\r
- SameMutableArrayOp,\r
- SameMutableByteArrayOp,\r
- ReadArrayOp,\r
- WriteArrayOp,\r
- IndexArrayOp,\r
- ReadByteArrayOp CharRep,\r
- ReadByteArrayOp IntRep,\r
- ReadByteArrayOp WordRep,\r
- ReadByteArrayOp AddrRep,\r
- ReadByteArrayOp FloatRep,\r
- ReadByteArrayOp DoubleRep,\r
- ReadByteArrayOp StablePtrRep,\r
- ReadByteArrayOp Int64Rep,\r
- ReadByteArrayOp Word64Rep,\r
- WriteByteArrayOp CharRep,\r
- WriteByteArrayOp IntRep,\r
- WriteByteArrayOp WordRep,\r
- WriteByteArrayOp AddrRep,\r
- WriteByteArrayOp FloatRep,\r
- WriteByteArrayOp DoubleRep,\r
- WriteByteArrayOp StablePtrRep,\r
- WriteByteArrayOp Int64Rep,\r
- WriteByteArrayOp Word64Rep,\r
- IndexByteArrayOp CharRep,\r
- IndexByteArrayOp IntRep,\r
- IndexByteArrayOp WordRep,\r
- IndexByteArrayOp AddrRep,\r
- IndexByteArrayOp FloatRep,\r
- IndexByteArrayOp DoubleRep,\r
- IndexByteArrayOp StablePtrRep,\r
- IndexByteArrayOp Int64Rep,\r
- IndexByteArrayOp Word64Rep,\r
- IndexOffForeignObjOp CharRep,\r
- IndexOffForeignObjOp AddrRep,\r
- IndexOffForeignObjOp IntRep,\r
- IndexOffForeignObjOp WordRep,\r
- IndexOffForeignObjOp FloatRep,\r
- IndexOffForeignObjOp DoubleRep,\r
- IndexOffForeignObjOp StablePtrRep,\r
- IndexOffForeignObjOp Int64Rep,\r
- IndexOffForeignObjOp Word64Rep,\r
- IndexOffAddrOp CharRep,\r
- IndexOffAddrOp IntRep,\r
- IndexOffAddrOp WordRep,\r
- IndexOffAddrOp AddrRep,\r
- IndexOffAddrOp FloatRep,\r
- IndexOffAddrOp DoubleRep,\r
- IndexOffAddrOp StablePtrRep,\r
- IndexOffAddrOp Int64Rep,\r
- IndexOffAddrOp Word64Rep,\r
- WriteOffAddrOp CharRep,\r
- WriteOffAddrOp IntRep,\r
- WriteOffAddrOp WordRep,\r
- WriteOffAddrOp AddrRep,\r
- WriteOffAddrOp FloatRep,\r
- WriteOffAddrOp DoubleRep,\r
- WriteOffAddrOp ForeignObjRep,\r
- WriteOffAddrOp StablePtrRep,\r
- WriteOffAddrOp Int64Rep,\r
- WriteOffAddrOp Word64Rep,\r
- UnsafeFreezeArrayOp,\r
- UnsafeFreezeByteArrayOp,\r
- UnsafeThawArrayOp,\r
- UnsafeThawByteArrayOp,\r
- SizeofByteArrayOp,\r
- SizeofMutableByteArrayOp,\r
- NewMutVarOp,\r
- ReadMutVarOp,\r
- WriteMutVarOp,\r
- SameMutVarOp,\r
- CatchOp,\r
- RaiseOp,\r
- NewMVarOp,\r
- TakeMVarOp,\r
- PutMVarOp,\r
- SameMVarOp,\r
- IsEmptyMVarOp,\r
- MakeForeignObjOp,\r
- WriteForeignObjOp,\r
- MkWeakOp,\r
- DeRefWeakOp,\r
- FinalizeWeakOp,\r
- MakeStableNameOp,\r
- EqStableNameOp,\r
- StableNameToIntOp,\r
- MakeStablePtrOp,\r
- DeRefStablePtrOp,\r
- EqStablePtrOp,\r
- ReallyUnsafePtrEqualityOp,\r
- ParGlobalOp,\r
- ParLocalOp,\r
- ParAtOp,\r
- ParAtAbsOp,\r
- ParAtRelOp,\r
- ParAtForNowOp,\r
- CopyableOp,\r
- NoFollowOp,\r
- SeqOp,\r
- ParOp,\r
- ForkOp,\r
- KillThreadOp,\r
- YieldOp,\r
- MyThreadIdOp,\r
- DelayOp,\r
- WaitReadOp,\r
- WaitWriteOp,\r
- DataToTagOp,\r
- TagToEnumOp\r
- ]\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsection[PrimOp-info]{The essential info about each @PrimOp@}\r
-%* *\r
-%************************************************************************\r
-\r
-The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may\r
-refer to the primitive operation. The conventional \tr{#}-for-\r
-unboxed ops is added on later.\r
-\r
-The reason for the funny characters in the names is so we do not\r
-interfere with the programmer's Haskell name spaces.\r
-\r
-We use @PrimKinds@ for the ``type'' information, because they're\r
-(slightly) more convenient to use than @TyCons@.\r
-\begin{code}\r
-data PrimOpInfo\r
- = Dyadic OccName -- string :: T -> T -> T\r
- Type\r
- | Monadic OccName -- string :: T -> T\r
- Type\r
- | Compare OccName -- string :: T -> T -> Bool\r
- Type\r
-\r
- | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T\r
- [TyVar] \r
- [Type] \r
- Type \r
-\r
-mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty\r
-mkMonadic str ty = Monadic (mkSrcVarOcc str) ty\r
-mkCompare str ty = Compare (mkSrcVarOcc str) ty\r
-mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty\r
-\end{code}\r
-\r
-Utility bits:\r
-\begin{code}\r
-one_Integer_ty = [intPrimTy, byteArrayPrimTy]\r
-two_Integer_tys\r
- = [intPrimTy, byteArrayPrimTy, -- first Integer pieces\r
- intPrimTy, byteArrayPrimTy] -- second '' pieces\r
-an_Integer_and_Int_tys\r
- = [intPrimTy, byteArrayPrimTy, -- Integer\r
- intPrimTy]\r
-\r
-unboxedPair = mkUnboxedTupleTy 2\r
-unboxedTriple = mkUnboxedTupleTy 3\r
-unboxedQuadruple = mkUnboxedTupleTy 4\r
-\r
-integerMonadic name = mkGenPrimOp name [] one_Integer_ty \r
- (unboxedPair one_Integer_ty)\r
-\r
-integerDyadic name = mkGenPrimOp name [] two_Integer_tys \r
- (unboxedPair one_Integer_ty)\r
-\r
-integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys \r
- (unboxedQuadruple two_Integer_tys)\r
-\r
-integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection{Strictness}\r
-%* *\r
-%************************************************************************\r
-\r
-Not all primops are strict!\r
-\r
-\begin{code}\r
-primOpStrictness :: PrimOp -> ([Demand], Bool)\r
- -- See IdInfo.StrictnessInfo for discussion of what the results\r
- -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,\r
- -- the list of demands may be infinite!\r
- -- Use only the ones you ned.\r
-\r
-primOpStrictness SeqOp = ([wwStrict], False)\r
- -- Seq is strict in its argument; see notes in ConFold.lhs\r
-\r
-primOpStrictness ParOp = ([wwLazy], False)\r
- -- But Par is lazy, to avoid that the sparked thing\r
- -- gets evaluted strictly, which it should *not* be\r
-\r
-primOpStrictness ForkOp = ([wwLazy, wwPrim], False)\r
-\r
-primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)\r
-primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)\r
-\r
-primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)\r
-primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)\r
-\r
-primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)\r
-\r
-primOpStrictness CatchOp = ([wwLazy, wwLazy], False)\r
-primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom\r
-\r
-primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)\r
-primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)\r
-primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)\r
-\r
-primOpStrictness DataToTagOp = ([wwLazy], False)\r
-\r
- -- The rest all have primitive-typed arguments\r
-primOpStrictness other = (repeat wwPrim, False)\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}\r
-%* *\r
-%************************************************************************\r
-\r
-@primOpInfo@ gives all essential information (from which everything\r
-else, notably a type, can be constructed) for each @PrimOp@.\r
-\r
-\begin{code}\r
-primOpInfo :: PrimOp -> PrimOpInfo\r
-\end{code}\r
-\r
-There's plenty of this stuff!\r
-\r
-\begin{code}\r
-primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy\r
-primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy\r
-primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy\r
-primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy\r
-primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy\r
-primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy\r
-\r
-primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy\r
-primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy\r
-primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy\r
-primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy\r
-primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy\r
-primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy\r
-\r
-primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy\r
-primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy\r
-primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy\r
-primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy\r
-primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy\r
-primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy\r
-\r
-primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy\r
-primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy\r
-primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy\r
-primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy\r
-primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy\r
-primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy\r
-\r
-primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy\r
-primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy\r
-primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy\r
-primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy\r
-primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy\r
-primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy\r
-\r
-primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy\r
-primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy\r
-primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy\r
-primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy\r
-primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy\r
-primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy\r
-\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy\r
-primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy\r
-primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy\r
-primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy\r
-primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy\r
-primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy\r
-\r
-primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy\r
-primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy\r
-\r
-primOpInfo IntAddCOp = \r
- mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy] \r
- (unboxedPair [intPrimTy, intPrimTy])\r
-\r
-primOpInfo IntSubCOp = \r
- mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy] \r
- (unboxedPair [intPrimTy, intPrimTy])\r
-\r
-primOpInfo IntMulCOp = \r
- mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy] \r
- (unboxedPair [intPrimTy, intPrimTy])\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-A @Word#@ is an unsigned @Int#@.\r
-\r
-\begin{code}\r
-primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy\r
-primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy\r
-\r
-primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy\r
-primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy\r
-primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy\r
-primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy\r
-\r
-primOpInfo SllOp\r
- = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy\r
-primOpInfo SrlOp\r
- = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy\r
-\r
-primOpInfo ISllOp\r
- = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy\r
-primOpInfo ISraOp\r
- = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy\r
-primOpInfo ISrlOp\r
- = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy\r
-\r
-primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy\r
-primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy\r
-primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy\r
-\end{code}\r
-\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-@decodeFloat#@ is given w/ Integer-stuff (it's similar).\r
-\r
-\begin{code}\r
-primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy\r
-primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy\r
-primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy\r
-primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy\r
-primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy\r
-\r
-primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy\r
-primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy\r
-\r
-primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy\r
-primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy\r
-primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy\r
-primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy\r
-primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy\r
-primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy\r
-primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy\r
-primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy\r
-primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy\r
-primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy\r
-primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy\r
-primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy\r
-primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}\r
-%* *\r
-%************************************************************************\r
-\r
-@decodeDouble#@ is given w/ Integer-stuff (it's similar).\r
-\r
-\begin{code}\r
-primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy\r
-primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy\r
-primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy\r
-primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy\r
-primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy\r
-\r
-primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy\r
-primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy\r
-\r
-primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy\r
-primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy\r
-\r
-primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy\r
-primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy\r
-primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy\r
-primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy\r
-primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy\r
-primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy\r
-primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy\r
-primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy\r
-primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy\r
-primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy\r
-primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy\r
-primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy\r
-primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")\r
-\r
-primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")\r
-primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")\r
-primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")\r
-primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")\r
-\r
-primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")\r
-primOpInfo IntegerCmpIntOp \r
- = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy\r
-\r
-primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")\r
-primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")\r
-\r
-primOpInfo Integer2IntOp\r
- = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy\r
-\r
-primOpInfo Integer2WordOp\r
- = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy\r
-\r
-primOpInfo Int2IntegerOp\r
- = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy] \r
- (unboxedPair one_Integer_ty)\r
-\r
-primOpInfo Word2IntegerOp\r
- = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy] \r
- (unboxedPair one_Integer_ty)\r
-\r
-primOpInfo Addr2IntegerOp\r
- = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy] \r
- (unboxedPair one_Integer_ty)\r
-\r
-primOpInfo IntegerToInt64Op\r
- = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy\r
-\r
-primOpInfo Int64ToIntegerOp\r
- = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]\r
- (unboxedPair one_Integer_ty)\r
-\r
-primOpInfo Word64ToIntegerOp\r
- = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy] \r
- (unboxedPair one_Integer_ty)\r
-\r
-primOpInfo IntegerToWord64Op\r
- = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy\r
-\end{code}\r
-\r
-Decoding of floating-point numbers is sorta Integer-related. Encoding\r
-is done with plain ccalls now (see PrelNumExtra.lhs).\r
-\r
-\begin{code}\r
-primOpInfo FloatDecodeOp\r
- = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy] \r
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])\r
-primOpInfo DoubleDecodeOp\r
- = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy] \r
- (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{verbatim}\r
-newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)\r
-newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)\r
-\end{verbatim}\r
-\r
-\begin{code}\r
-primOpInfo NewArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv] \r
- [intPrimTy, elt, state]\r
- (unboxedPair [state, mkMutableArrayPrimTy s elt])\r
-\r
-primOpInfo (NewByteArrayOp kind)\r
- = let\r
- s = alphaTy; s_tv = alphaTyVar\r
-\r
- op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")\r
- state = mkStatePrimTy s\r
- in\r
- mkGenPrimOp op_str [s_tv]\r
- [intPrimTy, state]\r
- (unboxedPair [state, mkMutableByteArrayPrimTy s])\r
-\r
----------------------------------------------------------------------------\r
-\r
-{-\r
-sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool\r
-sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool\r
--}\r
-\r
-primOpInfo SameMutableArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- mut_arr_ty = mkMutableArrayPrimTy s elt\r
- } in\r
- mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]\r
- boolTy\r
-\r
-primOpInfo SameMutableByteArrayOp\r
- = let {\r
- s = alphaTy; s_tv = alphaTyVar;\r
- mut_arr_ty = mkMutableByteArrayPrimTy s\r
- } in\r
- mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]\r
- boolTy\r
-\r
----------------------------------------------------------------------------\r
--- Primitive arrays of Haskell pointers:\r
-\r
-{-\r
-readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)\r
-writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s\r
-indexArray# :: Array# a -> Int# -> (# a #)\r
--}\r
-\r
-primOpInfo ReadArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]\r
- [mkMutableArrayPrimTy s elt, intPrimTy, state]\r
- (unboxedPair [state, elt])\r
-\r
-\r
-primOpInfo WriteArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- } in\r
- mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]\r
- [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]\r
- (mkStatePrimTy s)\r
-\r
-primOpInfo IndexArrayOp\r
- = let { elt = alphaTy; elt_tv = alphaTyVar } in\r
- mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]\r
- (mkUnboxedTupleTy 1 [elt])\r
-\r
----------------------------------------------------------------------------\r
--- Primitive arrays full of unboxed bytes:\r
-\r
-primOpInfo (ReadByteArrayOp kind)\r
- = let\r
- s = alphaTy; s_tv = alphaTyVar\r
-\r
- op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")\r
- (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
- state = mkStatePrimTy s\r
- in\r
- mkGenPrimOp op_str (s_tv:tvs)\r
- [mkMutableByteArrayPrimTy s, intPrimTy, state]\r
- (unboxedPair [state, prim_ty])\r
-\r
-primOpInfo (WriteByteArrayOp kind)\r
- = let\r
- s = alphaTy; s_tv = alphaTyVar\r
- op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")\r
- (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
- in\r
- mkGenPrimOp op_str (s_tv:tvs)\r
- [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]\r
- (mkStatePrimTy s)\r
-\r
-primOpInfo (IndexByteArrayOp kind)\r
- = let\r
- op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")\r
- (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
- in\r
- mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty\r
-\r
-primOpInfo (IndexOffForeignObjOp kind)\r
- = let\r
- op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")\r
- (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
- in\r
- mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty\r
-\r
-primOpInfo (IndexOffAddrOp kind)\r
- = let\r
- op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")\r
- (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
- in\r
- mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty\r
-\r
-primOpInfo (WriteOffAddrOp kind)\r
- = let\r
- s = alphaTy; s_tv = alphaTyVar\r
- op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")\r
- (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
- in\r
- mkGenPrimOp op_str (s_tv:tvs)\r
- [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]\r
- (mkStatePrimTy s)\r
-\r
----------------------------------------------------------------------------\r
-{-\r
-unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)\r
-unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)\r
-unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)\r
-unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)\r
--}\r
-\r
-primOpInfo UnsafeFreezeArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]\r
- [mkMutableArrayPrimTy s elt, state]\r
- (unboxedPair [state, mkArrayPrimTy elt])\r
-\r
-primOpInfo UnsafeFreezeByteArrayOp\r
- = let { \r
- s = alphaTy; s_tv = alphaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]\r
- [mkMutableByteArrayPrimTy s, state]\r
- (unboxedPair [state, byteArrayPrimTy])\r
-\r
-primOpInfo UnsafeThawArrayOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]\r
- [mkArrayPrimTy elt, state]\r
- (unboxedPair [state, mkMutableArrayPrimTy s elt])\r
-\r
-primOpInfo UnsafeThawByteArrayOp\r
- = let { \r
- s = alphaTy; s_tv = alphaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]\r
- [byteArrayPrimTy, state]\r
- (unboxedPair [state, mkMutableByteArrayPrimTy s])\r
-\r
----------------------------------------------------------------------------\r
-primOpInfo SizeofByteArrayOp\r
- = mkGenPrimOp\r
- SLIT("sizeofByteArray#") []\r
- [byteArrayPrimTy]\r
- intPrimTy\r
-\r
-primOpInfo SizeofMutableByteArrayOp\r
- = let { s = alphaTy; s_tv = alphaTyVar } in\r
- mkGenPrimOp\r
- SLIT("sizeofMutableByteArray#") [s_tv]\r
- [mkMutableByteArrayPrimTy s]\r
- intPrimTy\r
-\end{code}\r
-\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo NewMutVarOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv] \r
- [elt, state]\r
- (unboxedPair [state, mkMutVarPrimTy s elt])\r
-\r
-primOpInfo ReadMutVarOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- state = mkStatePrimTy s\r
- } in\r
- mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]\r
- [mkMutVarPrimTy s elt, state]\r
- (unboxedPair [state, elt])\r
-\r
-\r
-primOpInfo WriteMutVarOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- } in\r
- mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]\r
- [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]\r
- (mkStatePrimTy s)\r
-\r
-primOpInfo SameMutVarOp\r
- = let {\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
- mut_var_ty = mkMutVarPrimTy s elt\r
- } in\r
- mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]\r
- boolTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}\r
-%* *\r
-%************************************************************************\r
-\r
-catch :: IO a -> (IOError -> IO a) -> IO a\r
-catch# :: a -> (b -> a) -> a\r
-\r
-\begin{code}\r
-primOpInfo CatchOp \r
- = let\r
- a = alphaTy; a_tv = alphaTyVar\r
- b = betaTy; b_tv = betaTyVar;\r
- in\r
- mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a\r
-\r
-primOpInfo RaiseOp\r
- = let\r
- a = alphaTy; a_tv = alphaTyVar\r
- b = betaTy; b_tv = betaTyVar;\r
- in\r
- mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo NewMVarOp\r
- = let\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- state = mkStatePrimTy s\r
- in\r
- mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]\r
- (unboxedPair [state, mkMVarPrimTy s elt])\r
-\r
-primOpInfo TakeMVarOp\r
- = let\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- state = mkStatePrimTy s\r
- in\r
- mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]\r
- [mkMVarPrimTy s elt, state]\r
- (unboxedPair [state, elt])\r
-\r
-primOpInfo PutMVarOp\r
- = let\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- in\r
- mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]\r
- [mkMVarPrimTy s elt, elt, mkStatePrimTy s]\r
- (mkStatePrimTy s)\r
-\r
-primOpInfo SameMVarOp\r
- = let\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- mvar_ty = mkMVarPrimTy s elt\r
- in\r
- mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy\r
-\r
-primOpInfo IsEmptyMVarOp\r
- = let\r
- elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
- state = mkStatePrimTy s\r
- in\r
- mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]\r
- [mkMVarPrimTy s elt, mkStatePrimTy s]\r
- (unboxedPair [state, intPrimTy])\r
-\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-\r
-primOpInfo DelayOp\r
- = let {\r
- s = alphaTy; s_tv = alphaTyVar\r
- } in\r
- mkGenPrimOp SLIT("delay#") [s_tv]\r
- [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
-\r
-primOpInfo WaitReadOp\r
- = let {\r
- s = alphaTy; s_tv = alphaTyVar\r
- } in\r
- mkGenPrimOp SLIT("waitRead#") [s_tv]\r
- [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
-\r
-primOpInfo WaitWriteOp\r
- = let {\r
- s = alphaTy; s_tv = alphaTyVar\r
- } in\r
- mkGenPrimOp SLIT("waitWrite#") [s_tv]\r
- [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-Concurrency]{Concurrency Primitives}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
--- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)\r
-primOpInfo ForkOp \r
- = mkGenPrimOp SLIT("fork#") [alphaTyVar] \r
- [alphaTy, realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])\r
-\r
--- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld\r
-primOpInfo KillThreadOp\r
- = mkGenPrimOp SLIT("killThread#") [alphaTyVar] \r
- [threadIdPrimTy, alphaTy, realWorldStatePrimTy]\r
- realWorldStatePrimTy\r
-\r
--- yield# :: State# RealWorld -> State# RealWorld\r
-primOpInfo YieldOp\r
- = mkGenPrimOp SLIT("yield#") [] \r
- [realWorldStatePrimTy]\r
- realWorldStatePrimTy\r
-\r
--- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)\r
-primOpInfo MyThreadIdOp\r
- = mkGenPrimOp SLIT("myThreadId#") [] \r
- [realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])\r
-\end{code}\r
-\r
-************************************************************************\r
-%* *\r
-\subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo MakeForeignObjOp\r
- = mkGenPrimOp SLIT("makeForeignObj#") [] \r
- [addrPrimTy, realWorldStatePrimTy] \r
- (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])\r
-\r
-primOpInfo WriteForeignObjOp\r
- = let {\r
- s = alphaTy; s_tv = alphaTyVar\r
- } in\r
- mkGenPrimOp SLIT("writeForeignObj#") [s_tv]\r
- [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
-\end{code}\r
-\r
-************************************************************************\r
-%* *\r
-\subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}\r
-%* *\r
-%************************************************************************\r
-\r
-A @Weak@ Pointer is created by the @mkWeak#@ primitive:\r
-\r
- mkWeak# :: k -> v -> f -> State# RealWorld \r
- -> (# State# RealWorld, Weak# v #)\r
-\r
-In practice, you'll use the higher-level\r
-\r
- data Weak v = Weak# v\r
- mkWeak :: k -> v -> IO () -> IO (Weak v)\r
-\r
-\begin{code}\r
-primOpInfo MkWeakOp\r
- = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar] \r
- [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])\r
-\end{code}\r
-\r
-The following operation dereferences a weak pointer. The weak pointer\r
-may have been finalized, so the operation returns a result code which\r
-must be inspected before looking at the dereferenced value.\r
-\r
- deRefWeak# :: Weak# v -> State# RealWorld ->\r
- (# State# RealWorld, v, Int# #)\r
-\r
-Only look at v if the Int# returned is /= 0 !!\r
-\r
-The higher-level op is\r
-\r
- deRefWeak :: Weak v -> IO (Maybe v)\r
-\r
-\begin{code}\r
-primOpInfo DeRefWeakOp\r
- = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]\r
- [mkWeakPrimTy alphaTy, realWorldStatePrimTy]\r
- (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])\r
-\end{code}\r
-\r
-Weak pointers can be finalized early by using the finalize# operation:\r
- \r
- finalizeWeak# :: Weak# v -> State# RealWorld -> \r
- (# State# RealWorld, Int#, IO () #)\r
-\r
-The Int# returned is either\r
-\r
- 0 if the weak pointer has already been finalized, or it has no\r
- finalizer (the third component is then invalid).\r
-\r
- 1 if the weak pointer is still alive, with the finalizer returned\r
- as the third component.\r
-\r
-\begin{code}\r
-primOpInfo FinalizeWeakOp\r
- = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]\r
- [mkWeakPrimTy alphaTy, realWorldStatePrimTy]\r
- (unboxedTriple [realWorldStatePrimTy, intPrimTy,\r
- mkFunTy realWorldStatePrimTy \r
- (unboxedPair [realWorldStatePrimTy,unitTy])])\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}\r
-%* *\r
-%************************************************************************\r
-\r
-A {\em stable name/pointer} is an index into a table of stable name\r
-entries. Since the garbage collector is told about stable pointers,\r
-it is safe to pass a stable pointer to external systems such as C\r
-routines.\r
-\r
-\begin{verbatim}\r
-makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)\r
-freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld\r
-deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)\r
-eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#\r
-\end{verbatim}\r
-\r
-It may seem a bit surprising that @makeStablePtr#@ is a @IO@\r
-operation since it doesn't (directly) involve IO operations. The\r
-reason is that if some optimisation pass decided to duplicate calls to\r
-@makeStablePtr#@ and we only pass one of the stable pointers over, a\r
-massive space leak can result. Putting it into the IO monad\r
-prevents this. (Another reason for putting them in a monad is to\r
-ensure correct sequencing wrt the side-effecting @freeStablePtr@\r
-operation.)\r
-\r
-An important property of stable pointers is that if you call\r
-makeStablePtr# twice on the same object you get the same stable\r
-pointer back.\r
-\r
-Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,\r
-besides, it's not likely to be used from Haskell) so it's not a\r
-primop.\r
-\r
-Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]\r
-\r
-Stable Names\r
-~~~~~~~~~~~~\r
-\r
-A stable name is like a stable pointer, but with three important differences:\r
-\r
- (a) You can't deRef one to get back to the original object.\r
- (b) You can convert one to an Int.\r
- (c) You don't need to 'freeStableName'\r
-\r
-The existence of a stable name doesn't guarantee to keep the object it\r
-points to alive (unlike a stable pointer), hence (a).\r
-\r
-Invariants:\r
- \r
- (a) makeStableName always returns the same value for a given\r
- object (same as stable pointers).\r
-\r
- (b) if two stable names are equal, it implies that the objects\r
- from which they were created were the same.\r
-\r
- (c) stableNameToInt always returns the same Int for a given\r
- stable name.\r
-\r
-\begin{code}\r
-primOpInfo MakeStablePtrOp\r
- = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]\r
- [alphaTy, realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, \r
- mkTyConApp stablePtrPrimTyCon [alphaTy]])\r
-\r
-primOpInfo DeRefStablePtrOp\r
- = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]\r
- [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, alphaTy])\r
-\r
-primOpInfo EqStablePtrOp\r
- = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]\r
- [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]\r
- intPrimTy\r
-\r
-primOpInfo MakeStableNameOp\r
- = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]\r
- [alphaTy, realWorldStatePrimTy]\r
- (unboxedPair [realWorldStatePrimTy, \r
- mkTyConApp stableNamePrimTyCon [alphaTy]])\r
-\r
-primOpInfo EqStableNameOp\r
- = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]\r
- [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]\r
- intPrimTy\r
-\r
-primOpInfo StableNameToIntOp\r
- = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]\r
- [mkStableNamePrimTy alphaTy]\r
- intPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}\r
-%* *\r
-%************************************************************************\r
-\r
-[Alastair Reid is to blame for this!]\r
-\r
-These days, (Glasgow) Haskell seems to have a bit of everything from\r
-other languages: strict operations, mutable variables, sequencing,\r
-pointers, etc. About the only thing left is LISP's ability to test\r
-for pointer equality. So, let's add it in!\r
-\r
-\begin{verbatim}\r
-reallyUnsafePtrEquality :: a -> a -> Int#\r
-\end{verbatim}\r
-\r
-which tests any two closures (of the same type) to see if they're the\r
-same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid\r
-difficulties of trying to box up the result.)\r
-\r
-NB This is {\em really unsafe\/} because even something as trivial as\r
-a garbage collection might change the answer by removing indirections.\r
-Still, no-one's forcing you to use it. If you're worried about little\r
-things like loss of referential transparency, you might like to wrap\r
-it all up in a monad-like thing as John O'Donnell and John Hughes did\r
-for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop\r
-Proceedings?)\r
-\r
-I'm thinking of using it to speed up a critical equality test in some\r
-graphics stuff in a context where the possibility of saying that\r
-denotationally equal things aren't isn't a problem (as long as it\r
-doesn't happen too often.) ADR\r
-\r
-To Will: Jim said this was already in, but I can't see it so I'm\r
-adding it. Up to you whether you add it. (Note that this could have\r
-been readily implemented using a @veryDangerousCCall@ before they were\r
-removed...)\r
-\r
-\begin{code}\r
-primOpInfo ReallyUnsafePtrEqualityOp\r
- = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]\r
- [alphaTy, alphaTy] intPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo SeqOp -- seq# :: a -> Int#\r
- = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy\r
-\r
-primOpInfo ParOp -- par# :: a -> Int#\r
- = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy\r
-\end{code}\r
-\r
-\begin{code}\r
--- HWL: The first 4 Int# in all par... annotations denote:\r
--- name, granularity info, size of result, degree of parallelism\r
--- Same structure as _seq_ i.e. returns Int#\r
--- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine\r
--- `the processor containing the expression v'; it is not evaluated\r
-\r
-primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
-\r
-primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
-\r
-primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy\r
-\r
-primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
-\r
-primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
-\r
-primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
- = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy\r
-\r
-primOpInfo CopyableOp -- copyable# :: a -> Int#\r
- = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy\r
-\r
-primOpInfo NoFollowOp -- noFollow# :: a -> Int#\r
- = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}\r
-%* *\r
-%************************************************************************\r
-\r
-\begin{code}\r
-primOpInfo (CCallOp _ _ _ _)\r
- = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy\r
-\r
-{-\r
-primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)\r
- = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied\r
- where\r
- (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty\r
--}\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}\r
-%* *\r
-%************************************************************************\r
-\r
-These primops are pretty wierd.\r
-\r
- dataToTag# :: a -> Int (arg must be an evaluated data type)\r
- tagToEnum# :: Int -> a (result type must be an enumerated type)\r
-\r
-The constraints aren't currently checked by the front end, but the\r
-code generator will fall over if they aren't satisfied.\r
-\r
-\begin{code}\r
-primOpInfo DataToTagOp\r
- = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy\r
-\r
-primOpInfo TagToEnumOp\r
- = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy\r
-\r
-#ifdef DEBUG\r
-primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))\r
-#endif\r
-\end{code}\r
-\r
-%************************************************************************\r
-%* *\r
-\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}\r
-%* *\r
-%************************************************************************\r
-\r
-Some PrimOps need to be called out-of-line because they either need to\r
-perform a heap check or they block.\r
-\r
-\begin{code}\r
-primOpOutOfLine op\r
- = case op of\r
- TakeMVarOp -> True\r
- PutMVarOp -> True\r
- DelayOp -> True\r
- WaitReadOp -> True\r
- WaitWriteOp -> True\r
- CatchOp -> True\r
- RaiseOp -> True\r
- NewArrayOp -> True\r
- NewByteArrayOp _ -> True\r
- IntegerAddOp -> True\r
- IntegerSubOp -> True\r
- IntegerMulOp -> True\r
- IntegerGcdOp -> True\r
- IntegerQuotRemOp -> True\r
- IntegerDivModOp -> True\r
- Int2IntegerOp -> True\r
- Word2IntegerOp -> True\r
- Addr2IntegerOp -> True\r
- Word64ToIntegerOp -> True\r
- Int64ToIntegerOp -> True\r
- FloatDecodeOp -> True\r
- DoubleDecodeOp -> True\r
- MkWeakOp -> True\r
- FinalizeWeakOp -> True\r
- MakeStableNameOp -> True\r
- MakeForeignObjOp -> True\r
- NewMutVarOp -> True\r
- NewMVarOp -> True\r
- ForkOp -> True\r
- KillThreadOp -> True\r
- YieldOp -> True\r
- CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_\r
- -- the next one doesn't perform any heap checks,\r
- -- but it is of such an esoteric nature that\r
- -- it is done out-of-line rather than require\r
- -- the NCG to implement it.\r
- UnsafeThawArrayOp -> True\r
- _ -> False\r
-\end{code}\r
-\r
-Sometimes we may choose to execute a PrimOp even though it isn't\r
-certain that its result will be required; ie execute them\r
-``speculatively''. The same thing as ``cheap eagerness.'' Usually\r
-this is OK, because PrimOps are usually cheap, but it isn't OK for\r
-(a)~expensive PrimOps and (b)~PrimOps which can fail.\r
-\r
-See also @primOpIsCheap@ (below).\r
-\r
-PrimOps that have side effects also should not be executed speculatively\r
-or by data dependencies.\r
-\r
-\begin{code}\r
-primOpOkForSpeculation :: PrimOp -> Bool\r
-primOpOkForSpeculation op \r
- = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)\r
-\end{code}\r
-\r
-@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK\r
-WARNING), we just borrow some other predicates for a\r
-what-should-be-good-enough test. "Cheap" means willing to call it more\r
-than once. Evaluation order is unaffected.\r
-\r
-\begin{code}\r
-primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)\r
-\end{code}\r
-\r
-primOpIsDupable means that the use of the primop is small enough to\r
-duplicate into different case branches. See CoreUtils.exprIsDupable.\r
-\r
-\begin{code}\r
-primOpIsDupable (CCallOp _ _ _ _) = False\r
-primOpIsDupable op = not (primOpOutOfLine op)\r
-\end{code}\r
-\r
-\r
-\begin{code}\r
-primOpCanFail :: PrimOp -> Bool\r
--- Int.\r
-primOpCanFail IntQuotOp = True -- Divide by zero\r
-primOpCanFail IntRemOp = True -- Divide by zero\r
-\r
--- Integer\r
-primOpCanFail IntegerQuotRemOp = True -- Divide by zero\r
-primOpCanFail IntegerDivModOp = True -- Divide by zero\r
-\r
--- Float. ToDo: tan? tanh?\r
-primOpCanFail FloatDivOp = True -- Divide by zero\r
-primOpCanFail FloatLogOp = True -- Log of zero\r
-primOpCanFail FloatAsinOp = True -- Arg out of domain\r
-primOpCanFail FloatAcosOp = True -- Arg out of domain\r
-\r
--- Double. ToDo: tan? tanh?\r
-primOpCanFail DoubleDivOp = True -- Divide by zero\r
-primOpCanFail DoubleLogOp = True -- Log of zero\r
-primOpCanFail DoubleAsinOp = True -- Arg out of domain\r
-primOpCanFail DoubleAcosOp = True -- Arg out of domain\r
-\r
-primOpCanFail other_op = False\r
-\end{code}\r
-\r
-And some primops have side-effects and so, for example, must not be\r
-duplicated.\r
-\r
-\begin{code}\r
-primOpHasSideEffects :: PrimOp -> Bool\r
-\r
-primOpHasSideEffects TakeMVarOp = True\r
-primOpHasSideEffects DelayOp = True\r
-primOpHasSideEffects WaitReadOp = True\r
-primOpHasSideEffects WaitWriteOp = True\r
-\r
-primOpHasSideEffects ParOp = True\r
-primOpHasSideEffects ForkOp = True\r
-primOpHasSideEffects KillThreadOp = True\r
-primOpHasSideEffects YieldOp = True\r
-primOpHasSideEffects SeqOp = True\r
-\r
-primOpHasSideEffects MakeForeignObjOp = True\r
-primOpHasSideEffects WriteForeignObjOp = True\r
-primOpHasSideEffects MkWeakOp = True\r
-primOpHasSideEffects DeRefWeakOp = True\r
-primOpHasSideEffects FinalizeWeakOp = True\r
-primOpHasSideEffects MakeStablePtrOp = True\r
-primOpHasSideEffects MakeStableNameOp = True\r
-primOpHasSideEffects EqStablePtrOp = True -- SOF\r
-primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR\r
-\r
-primOpHasSideEffects ParGlobalOp = True\r
-primOpHasSideEffects ParLocalOp = True\r
-primOpHasSideEffects ParAtOp = True\r
-primOpHasSideEffects ParAtAbsOp = True\r
-primOpHasSideEffects ParAtRelOp = True\r
-primOpHasSideEffects ParAtForNowOp = True\r
-primOpHasSideEffects CopyableOp = True -- Possibly not. ASP \r
-primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP\r
-\r
--- CCall\r
-primOpHasSideEffects (CCallOp _ _ _ _) = True\r
-\r
-primOpHasSideEffects other = False\r
-\end{code}\r
-\r
-Inline primitive operations that perform calls need wrappers to save\r
-any live variables that are stored in caller-saves registers.\r
-\r
-\begin{code}\r
-primOpNeedsWrapper :: PrimOp -> Bool\r
-\r
-primOpNeedsWrapper (CCallOp _ _ _ _) = True\r
-\r
-primOpNeedsWrapper Integer2IntOp = True\r
-primOpNeedsWrapper Integer2WordOp = True\r
-primOpNeedsWrapper IntegerCmpOp = True\r
-primOpNeedsWrapper IntegerCmpIntOp = True\r
-\r
-primOpNeedsWrapper FloatExpOp = True\r
-primOpNeedsWrapper FloatLogOp = True\r
-primOpNeedsWrapper FloatSqrtOp = True\r
-primOpNeedsWrapper FloatSinOp = True\r
-primOpNeedsWrapper FloatCosOp = True\r
-primOpNeedsWrapper FloatTanOp = True\r
-primOpNeedsWrapper FloatAsinOp = True\r
-primOpNeedsWrapper FloatAcosOp = True\r
-primOpNeedsWrapper FloatAtanOp = True\r
-primOpNeedsWrapper FloatSinhOp = True\r
-primOpNeedsWrapper FloatCoshOp = True\r
-primOpNeedsWrapper FloatTanhOp = True\r
-primOpNeedsWrapper FloatPowerOp = True\r
-\r
-primOpNeedsWrapper DoubleExpOp = True\r
-primOpNeedsWrapper DoubleLogOp = True\r
-primOpNeedsWrapper DoubleSqrtOp = True\r
-primOpNeedsWrapper DoubleSinOp = True\r
-primOpNeedsWrapper DoubleCosOp = True\r
-primOpNeedsWrapper DoubleTanOp = True\r
-primOpNeedsWrapper DoubleAsinOp = True\r
-primOpNeedsWrapper DoubleAcosOp = True\r
-primOpNeedsWrapper DoubleAtanOp = True\r
-primOpNeedsWrapper DoubleSinhOp = True\r
-primOpNeedsWrapper DoubleCoshOp = True\r
-primOpNeedsWrapper DoubleTanhOp = True\r
-primOpNeedsWrapper DoublePowerOp = True\r
-\r
-primOpNeedsWrapper MakeStableNameOp = True\r
-primOpNeedsWrapper DeRefStablePtrOp = True\r
-\r
-primOpNeedsWrapper DelayOp = True\r
-primOpNeedsWrapper WaitReadOp = True\r
-primOpNeedsWrapper WaitWriteOp = True\r
-\r
-primOpNeedsWrapper other_op = False\r
-\end{code}\r
-\r
-\begin{code}\r
-primOpType :: PrimOp -> Type -- you may want to use primOpSig instead\r
-primOpType op\r
- = case (primOpInfo op) of\r
- Dyadic occ ty -> dyadic_fun_ty ty\r
- Monadic occ ty -> monadic_fun_ty ty\r
- Compare occ ty -> compare_fun_ty ty\r
-\r
- GenPrimOp occ tyvars arg_tys res_ty -> \r
- mkForAllTys tyvars (mkFunTys arg_tys res_ty)\r
-\r
-mkPrimOpIdName :: PrimOp -> Id -> Name\r
- -- Make the name for the PrimOp's Id\r
- -- We have to pass in the Id itself because it's a WiredInId\r
- -- and hence recursive\r
-mkPrimOpIdName op id\r
- = mkWiredInIdName key pREL_GHC occ_name id\r
- where\r
- occ_name = primOpOcc op\r
- key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))\r
-\r
-\r
-primOpRdrName :: PrimOp -> RdrName \r
-primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)\r
-\r
-primOpOcc :: PrimOp -> OccName\r
-primOpOcc op = case (primOpInfo op) of\r
- Dyadic occ _ -> occ\r
- Monadic occ _ -> occ\r
- Compare occ _ -> occ\r
- GenPrimOp occ _ _ _ -> occ\r
-\r
--- primOpSig is like primOpType but gives the result split apart:\r
--- (type variables, argument types, result type)\r
-\r
-primOpSig :: PrimOp -> ([TyVar],[Type],Type)\r
-primOpSig op\r
- = case (primOpInfo op) of\r
- Monadic occ ty -> ([], [ty], ty )\r
- Dyadic occ ty -> ([], [ty,ty], ty )\r
- Compare occ ty -> ([], [ty,ty], boolTy)\r
- GenPrimOp occ tyvars arg_tys res_ty\r
- -> (tyvars, arg_tys, res_ty)\r
-\r
--- primOpUsg is like primOpSig but the types it yields are the\r
--- appropriate sigma (i.e., usage-annotated) types,\r
--- as required by the UsageSP inference.\r
-\r
-primOpUsg :: PrimOp -> ([TyVar],[Type],Type)\r
-primOpUsg op\r
- = case op of\r
-\r
- -- Refer to comment by `otherwise' clause; we need consider here\r
- -- *only* primops that have arguments or results containing Haskell\r
- -- pointers (things that are pointed). Unpointed values are\r
- -- irrelevant to the usage analysis. The issue is whether pointed\r
- -- values may be entered or duplicated by the primop.\r
-\r
- -- Remember that primops are *never* partially applied.\r
-\r
- NewArrayOp -> mangle [mkP, mkM, mkP ] mkM\r
- SameMutableArrayOp -> mangle [mkP, mkP ] mkM\r
- ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM\r
- WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR\r
- IndexArrayOp -> mangle [mkM, mkP ] mkM\r
- UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM\r
- UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM\r
-\r
- NewMutVarOp -> mangle [mkM, mkP ] mkM\r
- ReadMutVarOp -> mangle [mkM, mkP ] mkM\r
- WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR\r
- SameMutVarOp -> mangle [mkP, mkP ] mkM\r
-\r
- CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO\r
- mangle [mkM, mkM . (inFun mkM mkM)] mkM\r
- -- might use caught action multiply\r
- RaiseOp -> mangle [mkM ] mkM\r
-\r
- NewMVarOp -> mangle [mkP ] mkR\r
- TakeMVarOp -> mangle [mkM, mkP ] mkM\r
- PutMVarOp -> mangle [mkM, mkM, mkP ] mkR\r
- SameMVarOp -> mangle [mkP, mkP ] mkM\r
- IsEmptyMVarOp -> mangle [mkP, mkP ] mkM\r
-\r
- ForkOp -> mangle [mkO, mkP ] mkR\r
- KillThreadOp -> mangle [mkP, mkM, mkP ] mkR\r
-\r
- MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM\r
- DeRefWeakOp -> mangle [mkM, mkP ] mkM\r
- FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))\r
-\r
- MakeStablePtrOp -> mangle [mkM, mkP ] mkM\r
- DeRefStablePtrOp -> mangle [mkM, mkP ] mkM\r
- EqStablePtrOp -> mangle [mkP, mkP ] mkR\r
- MakeStableNameOp -> mangle [mkZ, mkP ] mkR\r
- EqStableNameOp -> mangle [mkP, mkP ] mkR\r
- StableNameToIntOp -> mangle [mkP ] mkR\r
-\r
- ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR\r
-\r
- SeqOp -> mangle [mkO ] mkR\r
- ParOp -> mangle [mkO ] mkR\r
- ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
- ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
- ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM\r
- ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
- ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
- ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM\r
- CopyableOp -> mangle [mkZ ] mkR\r
- NoFollowOp -> mangle [mkZ ] mkR\r
-\r
- CCallOp _ _ _ _ -> mangle [ ] mkM\r
-\r
- -- Things with no Haskell pointers inside: in actuality, usages are\r
- -- irrelevant here (hence it doesn't matter that some of these\r
- -- apparently permit duplication; since such arguments are never \r
- -- ENTERed anyway, the usage annotation they get is entirely irrelevant\r
- -- except insofar as it propagates to infect other values that *are*\r
- -- pointed.\r
-\r
- otherwise -> nomangle\r
- \r
- where mkZ = mkUsgTy UsOnce -- pointed argument used zero\r
- mkO = mkUsgTy UsOnce -- pointed argument used once\r
- mkM = mkUsgTy UsMany -- pointed argument used multiply\r
- mkP = mkUsgTy UsOnce -- unpointed argument\r
- mkR = mkUsgTy UsMany -- unpointed result\r
- \r
- (tyvars, arg_tys, res_ty)\r
- = primOpSig op\r
-\r
- nomangle = (tyvars, map mkP arg_tys, mkR res_ty)\r
-\r
- mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)\r
-\r
- inFun f g ty = case splitFunTy_maybe ty of\r
- Just (a,b) -> mkFunTy (f a) (g b)\r
- Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)\r
-\r
- inUB fs ty = case splitTyConApp_maybe ty of\r
- Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )\r
- mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"\r
- ($) fs tys)\r
- Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)\r
-\end{code}\r
-\r
-\begin{code}\r
-data PrimOpResultInfo\r
- = ReturnsPrim PrimRep\r
- | ReturnsAlg TyCon\r
-\r
--- Some PrimOps need not return a manifest primitive or algebraic value\r
--- (i.e. they might return a polymorphic value). These PrimOps *must*\r
--- be out of line, or the code generator won't work.\r
-\r
-getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo\r
-getPrimOpResultInfo op\r
- = case (primOpInfo op) of\r
- Dyadic _ ty -> ReturnsPrim (typePrimRep ty)\r
- Monadic _ ty -> ReturnsPrim (typePrimRep ty)\r
- Compare _ ty -> ReturnsAlg boolTyCon\r
- GenPrimOp _ _ _ ty -> \r
- let rep = typePrimRep ty in\r
- case rep of\r
- PtrRep -> case splitAlgTyConApp_maybe ty of\r
- Nothing -> panic "getPrimOpResultInfo"\r
- Just (tc,_,_) -> ReturnsAlg tc\r
- other -> ReturnsPrim other\r
-\r
-isCompareOp :: PrimOp -> Bool\r
-isCompareOp op\r
- = case primOpInfo op of\r
- Compare _ _ -> True\r
- _ -> False\r
-\end{code}\r
-\r
-The commutable ops are those for which we will try to move constants\r
-to the right hand side for strength reduction.\r
-\r
-\begin{code}\r
-commutableOp :: PrimOp -> Bool\r
-\r
-commutableOp CharEqOp = True\r
-commutableOp CharNeOp = True\r
-commutableOp IntAddOp = True\r
-commutableOp IntMulOp = True\r
-commutableOp AndOp = True\r
-commutableOp OrOp = True\r
-commutableOp XorOp = True\r
-commutableOp IntEqOp = True\r
-commutableOp IntNeOp = True\r
-commutableOp IntegerAddOp = True\r
-commutableOp IntegerMulOp = True\r
-commutableOp IntegerGcdOp = True\r
-commutableOp FloatAddOp = True\r
-commutableOp FloatMulOp = True\r
-commutableOp FloatEqOp = True\r
-commutableOp FloatNeOp = True\r
-commutableOp DoubleAddOp = True\r
-commutableOp DoubleMulOp = True\r
-commutableOp DoubleEqOp = True\r
-commutableOp DoubleNeOp = True\r
-commutableOp _ = False\r
-\end{code}\r
-\r
-Utils:\r
-\begin{code}\r
-mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)\r
- -- CharRep --> ([], Char#)\r
- -- StablePtrRep --> ([a], StablePtr# a)\r
-mkPrimTyApp tvs kind\r
- = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))\r
- where\r
- tycon = primRepTyCon kind\r
- forall_tvs = take (tyConArity tycon) tvs\r
-\r
-dyadic_fun_ty ty = mkFunTys [ty, ty] ty\r
-monadic_fun_ty ty = mkFunTy ty ty\r
-compare_fun_ty ty = mkFunTys [ty, ty] boolTy\r
-\end{code}\r
-\r
-Output stuff:\r
-\begin{code}\r
-pprPrimOp :: PrimOp -> SDoc\r
-\r
-pprPrimOp (CCallOp fun is_casm may_gc cconv)\r
- = let\r
- callconv = text "{-" <> pprCallConv cconv <> text "-}"\r
-\r
- before\r
- | is_casm && may_gc = "casm_GC ``"\r
- | is_casm = "casm ``"\r
- | may_gc = "ccall_GC "\r
- | otherwise = "ccall "\r
-\r
- after\r
- | is_casm = text "''"\r
- | otherwise = empty\r
- \r
- ppr_dyn =\r
- case fun of\r
- Right _ -> text "dyn_"\r
- _ -> empty\r
-\r
- ppr_fun =\r
- case fun of\r
- Right _ -> text "\"\""\r
- Left fn -> ptext fn\r
- \r
- in\r
- hcat [ ifPprDebug callconv\r
- , text "__", ppr_dyn\r
- , text before , ppr_fun , after]\r
-\r
-pprPrimOp other_op\r
- = getPprStyle $ \ sty ->\r
- if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.\r
- ptext SLIT("PrelGHC.") <> pprOccName occ\r
- else\r
- pprOccName occ\r
- where\r
- occ = primOpOcc other_op\r
-\end{code}\r
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+\section[PrimOp]{Primitive operations (machine-level)}
+
+\begin{code}
+module PrimOp (
+ PrimOp(..), allThePrimOps,
+ primOpType, primOpSig, primOpUsg,
+ mkPrimOpIdName, primOpRdrName,
+
+ commutableOp,
+
+ primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
+ primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
+ primOpHasSideEffects,
+
+ getPrimOpResultInfo, PrimOpResultInfo(..),
+
+ pprPrimOp
+ ) where
+
+#include "HsVersions.h"
+
+import PrimRep -- most of it
+import TysPrim
+import TysWiredIn
+
+import Demand ( Demand, wwLazy, wwPrim, wwStrict )
+import Var ( TyVar, Id )
+import CallConv ( CallConv, pprCallConv )
+import PprType ( pprParendType )
+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, zipWithEqual )
+import GlaExts ( Int(..), Int#, (==#) )
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
+%* *
+%************************************************************************
+
+These are in \tr{state-interface.verb} order.
+
+\begin{code}
+data PrimOp
+ -- dig the FORTRAN/C influence on the names...
+
+ -- comparisons:
+
+ = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
+ | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
+ | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
+ | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
+ | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
+ | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
+
+ -- Char#-related ops:
+ | OrdOp | ChrOp
+
+ -- Int#-related ops:
+ -- IntAbsOp unused?? ADR
+ | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
+ | IntRemOp | IntNegOp | IntAbsOp
+ | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
+ | IntAddCOp
+ | IntSubCOp
+ | IntMulCOp
+
+ -- Word#-related ops:
+ | WordQuotOp | WordRemOp
+ | AndOp | OrOp | NotOp | XorOp
+ | SllOp | SrlOp -- shift {left,right} {logical}
+ | Int2WordOp | Word2IntOp -- casts
+
+ -- Addr#-related ops:
+ | Int2AddrOp | Addr2IntOp -- casts
+
+ -- Float#-related ops:
+ | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
+ | Float2IntOp | Int2FloatOp
+
+ | FloatExpOp | FloatLogOp | FloatSqrtOp
+ | FloatSinOp | FloatCosOp | FloatTanOp
+ | FloatAsinOp | FloatAcosOp | FloatAtanOp
+ | FloatSinhOp | FloatCoshOp | FloatTanhOp
+ -- not all machines have these available conveniently:
+ -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
+ | FloatPowerOp -- ** op
+
+ -- Double#-related ops:
+ | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
+ | Double2IntOp | Int2DoubleOp
+ | Double2FloatOp | Float2DoubleOp
+
+ | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
+ | DoubleSinOp | DoubleCosOp | DoubleTanOp
+ | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
+ | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
+ -- not all machines have these available conveniently:
+ -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
+ | DoublePowerOp -- ** op
+
+ -- Integer (and related...) ops:
+ -- slightly weird -- to match GMP package.
+ | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
+ | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
+
+ | IntegerCmpOp
+ | IntegerCmpIntOp
+
+ | Integer2IntOp | Integer2WordOp
+ | Int2IntegerOp | Word2IntegerOp
+ | Addr2IntegerOp
+ -- casting to/from Integer and 64-bit (un)signed quantities.
+ | IntegerToInt64Op | Int64ToIntegerOp
+ | IntegerToWord64Op | Word64ToIntegerOp
+ -- ?? gcd, etc?
+
+ | FloatDecodeOp
+ | DoubleDecodeOp
+
+ -- primitive ops for primitive arrays
+
+ | NewArrayOp
+ | NewByteArrayOp PrimRep
+
+ | SameMutableArrayOp
+ | SameMutableByteArrayOp
+
+ | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
+
+ | ReadByteArrayOp PrimRep
+ | WriteByteArrayOp PrimRep
+ | IndexByteArrayOp PrimRep
+ | IndexOffAddrOp PrimRep
+ | WriteOffAddrOp PrimRep
+ -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
+ -- This is just a cheesy encoding of a bunch of ops.
+ -- Note that ForeignObjRep is not included -- the only way of
+ -- creating a ForeignObj is with a ccall or casm.
+ | IndexOffForeignObjOp PrimRep
+
+ | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
+ | UnsafeThawArrayOp | UnsafeThawByteArrayOp
+ | SizeofByteArrayOp | SizeofMutableByteArrayOp
+
+ -- Mutable variables
+ | NewMutVarOp
+ | ReadMutVarOp
+ | WriteMutVarOp
+ | SameMutVarOp
+
+ -- for MVars
+ | NewMVarOp
+ | 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
+\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 ... )
+
+ -- Operation to test two closure addresses for equality (yes really!)
+ -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
+ | ReallyUnsafePtrEqualityOp
+
+ -- parallel stuff
+ | SeqOp
+ | ParOp
+
+ -- 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
+ | ParAtAbsOp -- specifies destination of local par (abs processor)
+ | ParAtRelOp -- specifies destination of local par (rel processor)
+ | ParAtForNowOp -- specifies initial destination of global par
+ | CopyableOp -- marks copyable code
+ | NoFollowOp -- marks non-followup expression
+
+ -- tag-related
+ | DataToTagOp
+ | TagToEnumOp
+\end{code}
+
+Used for the Ord instance
+
+\begin{code}
+tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
+tagOf_PrimOp CharGeOp = ILIT( 2)
+tagOf_PrimOp CharEqOp = ILIT( 3)
+tagOf_PrimOp CharNeOp = ILIT( 4)
+tagOf_PrimOp CharLtOp = ILIT( 5)
+tagOf_PrimOp CharLeOp = ILIT( 6)
+tagOf_PrimOp IntGtOp = ILIT( 7)
+tagOf_PrimOp IntGeOp = ILIT( 8)
+tagOf_PrimOp IntEqOp = ILIT( 9)
+tagOf_PrimOp IntNeOp = ILIT( 10)
+tagOf_PrimOp IntLtOp = ILIT( 11)
+tagOf_PrimOp IntLeOp = ILIT( 12)
+tagOf_PrimOp WordGtOp = ILIT( 13)
+tagOf_PrimOp WordGeOp = ILIT( 14)
+tagOf_PrimOp WordEqOp = ILIT( 15)
+tagOf_PrimOp WordNeOp = ILIT( 16)
+tagOf_PrimOp WordLtOp = ILIT( 17)
+tagOf_PrimOp WordLeOp = ILIT( 18)
+tagOf_PrimOp AddrGtOp = ILIT( 19)
+tagOf_PrimOp AddrGeOp = ILIT( 20)
+tagOf_PrimOp AddrEqOp = ILIT( 21)
+tagOf_PrimOp AddrNeOp = ILIT( 22)
+tagOf_PrimOp AddrLtOp = ILIT( 23)
+tagOf_PrimOp AddrLeOp = ILIT( 24)
+tagOf_PrimOp FloatGtOp = ILIT( 25)
+tagOf_PrimOp FloatGeOp = ILIT( 26)
+tagOf_PrimOp FloatEqOp = ILIT( 27)
+tagOf_PrimOp FloatNeOp = ILIT( 28)
+tagOf_PrimOp FloatLtOp = ILIT( 29)
+tagOf_PrimOp FloatLeOp = ILIT( 30)
+tagOf_PrimOp DoubleGtOp = ILIT( 31)
+tagOf_PrimOp DoubleGeOp = ILIT( 32)
+tagOf_PrimOp DoubleEqOp = ILIT( 33)
+tagOf_PrimOp DoubleNeOp = ILIT( 34)
+tagOf_PrimOp DoubleLtOp = ILIT( 35)
+tagOf_PrimOp DoubleLeOp = ILIT( 36)
+tagOf_PrimOp OrdOp = ILIT( 37)
+tagOf_PrimOp ChrOp = ILIT( 38)
+tagOf_PrimOp IntAddOp = ILIT( 39)
+tagOf_PrimOp IntSubOp = ILIT( 40)
+tagOf_PrimOp IntMulOp = ILIT( 41)
+tagOf_PrimOp IntQuotOp = ILIT( 42)
+tagOf_PrimOp IntRemOp = ILIT( 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 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
+
+instance Ord PrimOp where
+ op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
+ op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
+ op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
+ op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
+ op1 `compare` op2 | op1 < op2 = LT
+ | op1 == op2 = EQ
+ | otherwise = GT
+
+instance Outputable PrimOp where
+ ppr op = pprPrimOp op
+
+instance Show PrimOp where
+ showsPrec p op = showsPrecSDoc p (pprPrimOp op)
+\end{code}
+
+An @Enum@-derived list would be better; meanwhile... (ToDo)
+\begin{code}
+allThePrimOps
+ = [ CharGtOp,
+ CharGeOp,
+ CharEqOp,
+ CharNeOp,
+ CharLtOp,
+ CharLeOp,
+ IntGtOp,
+ IntGeOp,
+ IntEqOp,
+ IntNeOp,
+ IntLtOp,
+ IntLeOp,
+ WordGtOp,
+ WordGeOp,
+ WordEqOp,
+ WordNeOp,
+ WordLtOp,
+ WordLeOp,
+ AddrGtOp,
+ AddrGeOp,
+ AddrEqOp,
+ AddrNeOp,
+ AddrLtOp,
+ AddrLeOp,
+ FloatGtOp,
+ FloatGeOp,
+ FloatEqOp,
+ FloatNeOp,
+ FloatLtOp,
+ FloatLeOp,
+ DoubleGtOp,
+ DoubleGeOp,
+ DoubleEqOp,
+ DoubleNeOp,
+ DoubleLtOp,
+ DoubleLeOp,
+ OrdOp,
+ ChrOp,
+ IntAddOp,
+ IntSubOp,
+ IntMulOp,
+ IntQuotOp,
+ IntRemOp,
+ IntNegOp,
+ WordQuotOp,
+ WordRemOp,
+ AndOp,
+ OrOp,
+ NotOp,
+ XorOp,
+ SllOp,
+ SrlOp,
+ ISllOp,
+ ISraOp,
+ ISrlOp,
+ IntAddCOp,
+ IntSubCOp,
+ IntMulCOp,
+ Int2WordOp,
+ Word2IntOp,
+ Int2AddrOp,
+ Addr2IntOp,
+
+ FloatAddOp,
+ FloatSubOp,
+ FloatMulOp,
+ FloatDivOp,
+ FloatNegOp,
+ Float2IntOp,
+ Int2FloatOp,
+ FloatExpOp,
+ FloatLogOp,
+ FloatSqrtOp,
+ FloatSinOp,
+ FloatCosOp,
+ FloatTanOp,
+ FloatAsinOp,
+ FloatAcosOp,
+ FloatAtanOp,
+ FloatSinhOp,
+ FloatCoshOp,
+ FloatTanhOp,
+ FloatPowerOp,
+ DoubleAddOp,
+ DoubleSubOp,
+ DoubleMulOp,
+ DoubleDivOp,
+ DoubleNegOp,
+ Double2IntOp,
+ Int2DoubleOp,
+ Double2FloatOp,
+ Float2DoubleOp,
+ DoubleExpOp,
+ DoubleLogOp,
+ DoubleSqrtOp,
+ DoubleSinOp,
+ DoubleCosOp,
+ DoubleTanOp,
+ DoubleAsinOp,
+ DoubleAcosOp,
+ DoubleAtanOp,
+ DoubleSinhOp,
+ DoubleCoshOp,
+ DoubleTanhOp,
+ DoublePowerOp,
+ IntegerAddOp,
+ IntegerSubOp,
+ IntegerMulOp,
+ IntegerGcdOp,
+ IntegerQuotRemOp,
+ IntegerDivModOp,
+ IntegerNegOp,
+ IntegerCmpOp,
+ IntegerCmpIntOp,
+ Integer2IntOp,
+ Integer2WordOp,
+ Int2IntegerOp,
+ Word2IntegerOp,
+ Addr2IntegerOp,
+ IntegerToInt64Op,
+ Int64ToIntegerOp,
+ IntegerToWord64Op,
+ Word64ToIntegerOp,
+ FloatDecodeOp,
+ DoubleDecodeOp,
+ NewArrayOp,
+ NewByteArrayOp CharRep,
+ NewByteArrayOp IntRep,
+ NewByteArrayOp WordRep,
+ NewByteArrayOp AddrRep,
+ NewByteArrayOp FloatRep,
+ NewByteArrayOp DoubleRep,
+ NewByteArrayOp StablePtrRep,
+ SameMutableArrayOp,
+ SameMutableByteArrayOp,
+ ReadArrayOp,
+ WriteArrayOp,
+ IndexArrayOp,
+ ReadByteArrayOp CharRep,
+ ReadByteArrayOp IntRep,
+ ReadByteArrayOp WordRep,
+ ReadByteArrayOp AddrRep,
+ ReadByteArrayOp FloatRep,
+ ReadByteArrayOp DoubleRep,
+ ReadByteArrayOp StablePtrRep,
+ ReadByteArrayOp Int64Rep,
+ ReadByteArrayOp Word64Rep,
+ WriteByteArrayOp CharRep,
+ WriteByteArrayOp IntRep,
+ WriteByteArrayOp WordRep,
+ WriteByteArrayOp AddrRep,
+ WriteByteArrayOp FloatRep,
+ WriteByteArrayOp DoubleRep,
+ WriteByteArrayOp StablePtrRep,
+ WriteByteArrayOp Int64Rep,
+ WriteByteArrayOp Word64Rep,
+ IndexByteArrayOp CharRep,
+ IndexByteArrayOp IntRep,
+ IndexByteArrayOp WordRep,
+ IndexByteArrayOp AddrRep,
+ IndexByteArrayOp FloatRep,
+ IndexByteArrayOp DoubleRep,
+ IndexByteArrayOp StablePtrRep,
+ IndexByteArrayOp Int64Rep,
+ IndexByteArrayOp Word64Rep,
+ IndexOffForeignObjOp CharRep,
+ IndexOffForeignObjOp AddrRep,
+ IndexOffForeignObjOp IntRep,
+ IndexOffForeignObjOp WordRep,
+ IndexOffForeignObjOp FloatRep,
+ IndexOffForeignObjOp DoubleRep,
+ IndexOffForeignObjOp StablePtrRep,
+ IndexOffForeignObjOp Int64Rep,
+ IndexOffForeignObjOp Word64Rep,
+ IndexOffAddrOp CharRep,
+ IndexOffAddrOp IntRep,
+ IndexOffAddrOp WordRep,
+ IndexOffAddrOp AddrRep,
+ IndexOffAddrOp FloatRep,
+ IndexOffAddrOp DoubleRep,
+ IndexOffAddrOp StablePtrRep,
+ IndexOffAddrOp Int64Rep,
+ IndexOffAddrOp Word64Rep,
+ WriteOffAddrOp CharRep,
+ WriteOffAddrOp IntRep,
+ WriteOffAddrOp WordRep,
+ WriteOffAddrOp AddrRep,
+ WriteOffAddrOp FloatRep,
+ WriteOffAddrOp DoubleRep,
+ WriteOffAddrOp ForeignObjRep,
+ WriteOffAddrOp StablePtrRep,
+ WriteOffAddrOp Int64Rep,
+ WriteOffAddrOp Word64Rep,
+ UnsafeFreezeArrayOp,
+ UnsafeFreezeByteArrayOp,
+ UnsafeThawArrayOp,
+ UnsafeThawByteArrayOp,
+ SizeofByteArrayOp,
+ SizeofMutableByteArrayOp,
+ NewMutVarOp,
+ ReadMutVarOp,
+ WriteMutVarOp,
+ SameMutVarOp,
+ CatchOp,
+ RaiseOp,
+ NewMVarOp,
+ TakeMVarOp,
+ PutMVarOp,
+ SameMVarOp,
+ IsEmptyMVarOp,
+ MakeForeignObjOp,
+ WriteForeignObjOp,
+ MkWeakOp,
+ DeRefWeakOp,
+ FinalizeWeakOp,
+ MakeStableNameOp,
+ EqStableNameOp,
+ StableNameToIntOp,
+ MakeStablePtrOp,
+ DeRefStablePtrOp,
+ EqStablePtrOp,
+ ReallyUnsafePtrEqualityOp,
+ ParGlobalOp,
+ ParLocalOp,
+ ParAtOp,
+ ParAtAbsOp,
+ ParAtRelOp,
+ ParAtForNowOp,
+ CopyableOp,
+ NoFollowOp,
+ SeqOp,
+ ParOp,
+ ForkOp,
+ KillThreadOp,
+ YieldOp,
+ MyThreadIdOp,
+ DelayOp,
+ WaitReadOp,
+ WaitWriteOp,
+ DataToTagOp,
+ TagToEnumOp
+ ]
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[PrimOp-info]{The essential info about each @PrimOp@}
+%* *
+%************************************************************************
+
+The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
+refer to the primitive operation. The conventional \tr{#}-for-
+unboxed ops is added on later.
+
+The reason for the funny characters in the names is so we do not
+interfere with the programmer's Haskell name spaces.
+
+We use @PrimKinds@ for the ``type'' information, because they're
+(slightly) more convenient to use than @TyCons@.
+\begin{code}
+data PrimOpInfo
+ = Dyadic OccName -- string :: T -> T -> T
+ Type
+ | Monadic OccName -- string :: T -> T
+ Type
+ | Compare OccName -- string :: T -> T -> Bool
+ Type
+
+ | 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, byteArrayPrimTy]
+two_Integer_tys
+ = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
+ intPrimTy, byteArrayPrimTy] -- second '' pieces
+an_Integer_and_Int_tys
+ = [intPrimTy, byteArrayPrimTy, -- Integer
+ intPrimTy]
+
+unboxedPair = mkUnboxedTupleTy 2
+unboxedTriple = mkUnboxedTupleTy 3
+unboxedQuadruple = mkUnboxedTupleTy 4
+
+integerMonadic name = mkGenPrimOp name [] one_Integer_ty
+ (unboxedPair one_Integer_ty)
+
+integerDyadic name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedPair one_Integer_ty)
+
+integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
+ (unboxedQuadruple two_Integer_tys)
+
+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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
+%* *
+%************************************************************************
+
+@primOpInfo@ gives all essential information (from which everything
+else, notably a type, can be constructed) for each @PrimOp@.
+
+\begin{code}
+primOpInfo :: PrimOp -> PrimOpInfo
+\end{code}
+
+There's plenty of this stuff!
+
+\begin{code}
+primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
+primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
+primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
+primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
+primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
+primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
+
+primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
+primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
+primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
+primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
+primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
+primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
+
+primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
+primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
+primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
+primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
+primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
+primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
+
+primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
+primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
+primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
+primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
+primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
+primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
+
+primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
+primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
+primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
+primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
+primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
+primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
+
+primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
+primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
+primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
+primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
+primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
+primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
+
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
+primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
+%* *
+%************************************************************************
+
+\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 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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
+%* *
+%************************************************************************
+
+A @Word#@ is an unsigned @Int#@.
+
+\begin{code}
+primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
+primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
+
+primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
+primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
+primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
+primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
+
+primOpInfo SllOp
+ = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
+primOpInfo SrlOp
+ = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
+
+primOpInfo ISllOp
+ = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
+primOpInfo ISraOp
+ = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
+primOpInfo ISrlOp
+ = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
+
+primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
+primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
+primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
+%* *
+%************************************************************************
+
+@decodeFloat#@ is given w/ Integer-stuff (it's similar).
+
+\begin{code}
+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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
+%* *
+%************************************************************************
+
+@decodeDouble#@ is given w/ Integer-stuff (it's similar).
+
+\begin{code}
+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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
+
+primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
+primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
+primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
+primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
+
+primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
+primOpInfo IntegerCmpIntOp
+ = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
+
+primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
+primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
+
+primOpInfo Integer2IntOp
+ = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
+
+primOpInfo Integer2WordOp
+ = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
+
+primOpInfo Int2IntegerOp
+ = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
+ (unboxedPair one_Integer_ty)
+
+primOpInfo Word2IntegerOp
+ = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
+ (unboxedPair one_Integer_ty)
+
+primOpInfo Addr2IntegerOp
+ = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
+ (unboxedPair one_Integer_ty)
+
+primOpInfo IntegerToInt64Op
+ = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
+
+primOpInfo Int64ToIntegerOp
+ = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
+ (unboxedPair one_Integer_ty)
+
+primOpInfo Word64ToIntegerOp
+ = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
+ (unboxedPair one_Integer_ty)
+
+primOpInfo IntegerToWord64Op
+ = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
+\end{code}
+
+Decoding of floating-point numbers is sorta Integer-related. Encoding
+is done with plain ccalls now (see PrelNumExtra.lhs).
+
+\begin{code}
+primOpInfo FloatDecodeOp
+ = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+primOpInfo DoubleDecodeOp
+ = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
+ (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
+%* *
+%************************************************************************
+
+\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
+ mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
+ [intPrimTy, elt, state]
+ (unboxedPair [state, mkMutableArrayPrimTy s elt])
+
+primOpInfo (NewByteArrayOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+
+ op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
+ state = mkStatePrimTy s
+ in
+ 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
+ mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
+ boolTy
+
+primOpInfo SameMutableByteArrayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar;
+ mut_arr_ty = mkMutableByteArrayPrimTy s
+ } in
+ 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
+ mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
+ [mkMutableArrayPrimTy s elt, intPrimTy, state]
+ (unboxedPair [state, elt])
+
+
+primOpInfo WriteArrayOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ } in
+ 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
+ mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
+ (mkUnboxedTupleTy 1 [elt])
+
+---------------------------------------------------------------------------
+-- Primitive arrays full of unboxed bytes:
+
+primOpInfo (ReadByteArrayOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+
+ op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp op_str (s_tv:tvs)
+ [mkMutableByteArrayPrimTy s, intPrimTy, state]
+ (unboxedPair [state, prim_ty])
+
+primOpInfo (WriteByteArrayOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+ op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
+ in
+ 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#")
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
+ in
+ mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
+
+primOpInfo (IndexOffForeignObjOp kind)
+ = let
+ op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
+ in
+ mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
+
+primOpInfo (IndexOffAddrOp kind)
+ = let
+ op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
+ (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
+ in
+ mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
+
+primOpInfo (WriteOffAddrOp kind)
+ = let
+ s = alphaTy; s_tv = alphaTyVar
+ op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
+ (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
+ in
+ 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
+ mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
+ [mkMutableArrayPrimTy s elt, state]
+ (unboxedPair [state, mkArrayPrimTy elt])
+
+primOpInfo UnsafeFreezeByteArrayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
+ [mkMutableByteArrayPrimTy s, state]
+ (unboxedPair [state, byteArrayPrimTy])
+
+primOpInfo 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
+ = mkGenPrimOp
+ SLIT("sizeofByteArray#") []
+ [byteArrayPrimTy]
+ intPrimTy
+
+primOpInfo SizeofMutableByteArrayOp
+ = let { s = alphaTy; s_tv = alphaTyVar } in
+ mkGenPrimOp
+ SLIT("sizeofMutableByteArray#") [s_tv]
+ [mkMutableByteArrayPrimTy s]
+ intPrimTy
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo NewMutVarOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
+ [elt, state]
+ (unboxedPair [state, mkMutVarPrimTy s elt])
+
+primOpInfo ReadMutVarOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ state = mkStatePrimTy s
+ } in
+ mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
+ [mkMutVarPrimTy s elt, state]
+ (unboxedPair [state, elt])
+
+
+primOpInfo WriteMutVarOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ } in
+ mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
+ [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
+ (mkStatePrimTy s)
+
+primOpInfo SameMutVarOp
+ = let {
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
+ mut_var_ty = mkMutVarPrimTy s elt
+ } in
+ mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
+ boolTy
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
+%* *
+%************************************************************************
+
+catch :: IO a -> (IOError -> IO a) -> IO a
+catch# :: a -> (b -> a) -> a
+
+\begin{code}
+primOpInfo CatchOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar
+ b = betaTy; b_tv = betaTyVar;
+ in
+ mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
+
+primOpInfo RaiseOp
+ = let
+ a = alphaTy; a_tv = alphaTyVar
+ b = betaTy; b_tv = betaTyVar;
+ in
+ mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo NewMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
+ (unboxedPair [state, mkMVarPrimTy s elt])
+
+primOpInfo TakeMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ state = mkStatePrimTy s
+ in
+ mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, state]
+ (unboxedPair [state, elt])
+
+primOpInfo PutMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ in
+ mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
+ [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
+ (mkStatePrimTy s)
+
+primOpInfo SameMVarOp
+ = let
+ elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
+ mvar_ty = mkMVarPrimTy s elt
+ in
+ mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
+
+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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
+%* *
+%************************************************************************
+
+\begin{code}
+
+primOpInfo DelayOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("delay#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+
+primOpInfo WaitReadOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("waitRead#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+
+primOpInfo WaitWriteOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("waitWrite#") [s_tv]
+ [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
+%* *
+%************************************************************************
+
+\begin{code}
+-- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
+primOpInfo ForkOp
+ = mkGenPrimOp SLIT("fork#") [alphaTyVar]
+ [alphaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
+
+-- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
+primOpInfo KillThreadOp
+ = 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}
+
+************************************************************************
+%* *
+\subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo MakeForeignObjOp
+ = mkGenPrimOp SLIT("makeForeignObj#") []
+ [addrPrimTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
+
+primOpInfo WriteForeignObjOp
+ = let {
+ s = alphaTy; s_tv = alphaTyVar
+ } in
+ mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
+ [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
+\end{code}
+
+************************************************************************
+%* *
+\subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
+%* *
+%************************************************************************
+
+A @Weak@ Pointer is created by the @mkWeak#@ primitive:
+
+ mkWeak# :: k -> v -> f -> State# RealWorld
+ -> (# State# RealWorld, Weak# v #)
+
+In practice, you'll use the higher-level
+
+ data Weak v = Weak# v
+ mkWeak :: k -> v -> IO () -> IO (Weak v)
+
+\begin{code}
+primOpInfo MkWeakOp
+ = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
+ [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
+\end{code}
+
+The following operation dereferences a weak pointer. The weak pointer
+may have been finalized, so the operation returns a result code which
+must be inspected before looking at the dereferenced value.
+
+ deRefWeak# :: Weak# v -> State# RealWorld ->
+ (# State# RealWorld, v, Int# #)
+
+Only look at v if the Int# returned is /= 0 !!
+
+The higher-level op is
+
+ deRefWeak :: Weak v -> IO (Maybe v)
+
+\begin{code}
+primOpInfo DeRefWeakOp
+ = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
+ [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
+ (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
+\end{code}
+
+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 and stable names}
+%* *
+%************************************************************************
+
+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.
+
+\begin{verbatim}
+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 @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 IO monad
+prevents this. (Another reason for putting them in a monad is to
+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]
+
+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
+ = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
+ [alphaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy,
+ mkTyConApp stablePtrPrimTyCon [alphaTy]])
+
+primOpInfo DeRefStablePtrOp
+ = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
+ [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
+ (unboxedPair [realWorldStatePrimTy, alphaTy])
+
+primOpInfo EqStablePtrOp
+ = 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}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
+%* *
+%************************************************************************
+
+[Alastair Reid is to blame for this!]
+
+These days, (Glasgow) Haskell seems to have a bit of everything from
+other languages: strict operations, mutable variables, sequencing,
+pointers, etc. About the only thing left is LISP's ability to test
+for pointer equality. So, let's add it in!
+
+\begin{verbatim}
+reallyUnsafePtrEquality :: a -> a -> Int#
+\end{verbatim}
+
+which tests any two closures (of the same type) to see if they're the
+same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
+difficulties of trying to box up the result.)
+
+NB This is {\em really unsafe\/} because even something as trivial as
+a garbage collection might change the answer by removing indirections.
+Still, no-one's forcing you to use it. If you're worried about little
+things like loss of referential transparency, you might like to wrap
+it all up in a monad-like thing as John O'Donnell and John Hughes did
+for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
+Proceedings?)
+
+I'm thinking of using it to speed up a critical equality test in some
+graphics stuff in a context where the possibility of saying that
+denotationally equal things aren't isn't a problem (as long as it
+doesn't happen too often.) ADR
+
+To Will: Jim said this was already in, but I can't see it so I'm
+adding it. Up to you whether you add it. (Note that this could have
+been readily implemented using a @veryDangerousCCall@ before they were
+removed...)
+
+\begin{code}
+primOpInfo ReallyUnsafePtrEqualityOp
+ = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
+ [alphaTy, alphaTy] intPrimTy
+\end{code}
+
+%************************************************************************
+%* *
+\subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
+%* *
+%************************************************************************
+
+\begin{code}
+primOpInfo SeqOp -- seq# :: a -> Int#
+ = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
+
+primOpInfo ParOp -- par# :: a -> Int#
+ = 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# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parGlobal#") [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# :: 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# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
+ = mkGenPrimOp SLIT("parAtAbs#") [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# :: 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 -> Int#
+ = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
+
+primOpInfo NoFollowOp -- noFollow# :: a -> Int#
+ = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
+\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#@}
+%* *
+%************************************************************************
+
+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.
+
+\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,
+ -- 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}
+
+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.
+
+See also @primOpIsCheap@ (below).
+
+PrimOps that have side effects also should not be executed speculatively
+or by data dependencies.
+
+\begin{code}
+primOpOkForSpeculation :: PrimOp -> Bool
+primOpOkForSpeculation op
+ = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
+\end{code}
+
+@primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
+WARNING), we just borrow some other predicates for a
+what-should-be-good-enough test. "Cheap" means willing to call it more
+than once. Evaluation order is unaffected.
+
+\begin{code}
+primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
+\end{code}
+
+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 IntQuotOp = True -- Divide by zero
+primOpCanFail IntRemOp = True -- Divide by zero
+
+-- Integer
+primOpCanFail IntegerQuotRemOp = True -- Divide by zero
+primOpCanFail IntegerDivModOp = True -- Divide by zero
+
+-- Float. ToDo: tan? tanh?
+primOpCanFail FloatDivOp = True -- Divide by zero
+primOpCanFail FloatLogOp = True -- Log of zero
+primOpCanFail FloatAsinOp = True -- Arg out of domain
+primOpCanFail FloatAcosOp = True -- Arg out of domain
+
+-- Double. ToDo: tan? tanh?
+primOpCanFail DoubleDivOp = True -- Divide by zero
+primOpCanFail DoubleLogOp = True -- Log of zero
+primOpCanFail DoubleAsinOp = True -- Arg out of domain
+primOpCanFail DoubleAcosOp = True -- Arg out of domain
+
+primOpCanFail other_op = False
+\end{code}
+
+And some primops have side-effects and so, for example, must not be
+duplicated.
+
+\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 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
+
+primOpHasSideEffects ParGlobalOp = True
+primOpHasSideEffects ParLocalOp = True
+primOpHasSideEffects ParAtOp = True
+primOpHasSideEffects ParAtAbsOp = True
+primOpHasSideEffects ParAtRelOp = True
+primOpHasSideEffects ParAtForNowOp = True
+primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
+primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
+
+-- CCall
+primOpHasSideEffects (CCallOp _ _ _ _) = True
+
+primOpHasSideEffects other = False
+\end{code}
+
+Inline primitive operations that perform calls need wrappers to save
+any live variables that are stored in caller-saves registers.
+
+\begin{code}
+primOpNeedsWrapper :: PrimOp -> Bool
+
+primOpNeedsWrapper (CCallOp _ _ _ _) = True
+
+primOpNeedsWrapper Integer2IntOp = True
+primOpNeedsWrapper Integer2WordOp = True
+primOpNeedsWrapper IntegerCmpOp = True
+primOpNeedsWrapper IntegerCmpIntOp = True
+
+primOpNeedsWrapper FloatExpOp = True
+primOpNeedsWrapper FloatLogOp = True
+primOpNeedsWrapper FloatSqrtOp = True
+primOpNeedsWrapper FloatSinOp = True
+primOpNeedsWrapper FloatCosOp = True
+primOpNeedsWrapper FloatTanOp = True
+primOpNeedsWrapper FloatAsinOp = True
+primOpNeedsWrapper FloatAcosOp = True
+primOpNeedsWrapper FloatAtanOp = True
+primOpNeedsWrapper FloatSinhOp = True
+primOpNeedsWrapper FloatCoshOp = True
+primOpNeedsWrapper FloatTanhOp = True
+primOpNeedsWrapper FloatPowerOp = True
+
+primOpNeedsWrapper DoubleExpOp = True
+primOpNeedsWrapper DoubleLogOp = True
+primOpNeedsWrapper DoubleSqrtOp = True
+primOpNeedsWrapper DoubleSinOp = True
+primOpNeedsWrapper DoubleCosOp = True
+primOpNeedsWrapper DoubleTanOp = True
+primOpNeedsWrapper DoubleAsinOp = True
+primOpNeedsWrapper DoubleAcosOp = True
+primOpNeedsWrapper DoubleAtanOp = True
+primOpNeedsWrapper DoubleSinhOp = True
+primOpNeedsWrapper DoubleCoshOp = True
+primOpNeedsWrapper DoubleTanhOp = True
+primOpNeedsWrapper DoublePowerOp = True
+
+primOpNeedsWrapper MakeStableNameOp = True
+primOpNeedsWrapper DeRefStablePtrOp = True
+
+primOpNeedsWrapper DelayOp = True
+primOpNeedsWrapper WaitReadOp = True
+primOpNeedsWrapper WaitWriteOp = True
+
+primOpNeedsWrapper other_op = False
+\end{code}
+
+\begin{code}
+primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
+primOpType op
+ = case (primOpInfo op) of
+ Dyadic occ ty -> dyadic_fun_ty ty
+ Monadic occ ty -> monadic_fun_ty ty
+ Compare occ ty -> compare_fun_ty ty
+
+ GenPrimOp occ tyvars arg_tys res_ty ->
+ mkForAllTys tyvars (mkFunTys arg_tys res_ty)
+
+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
+ 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
+
+ -- 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}
+data PrimOpResultInfo
+ = ReturnsPrim PrimRep
+ | ReturnsAlg TyCon
+
+-- Some PrimOps need not return a manifest primitive or algebraic value
+-- (i.e. they might return a polymorphic value). These PrimOps *must*
+-- be out of line, or the code generator won't work.
+
+getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
+getPrimOpResultInfo op
+ = case (primOpInfo op) of
+ Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
+ Monadic _ ty -> ReturnsPrim (typePrimRep ty)
+ Compare _ ty -> ReturnsAlg boolTyCon
+ GenPrimOp _ _ _ ty ->
+ let rep = typePrimRep ty in
+ case rep of
+ PtrRep -> case splitAlgTyConApp_maybe ty of
+ Nothing -> panic "getPrimOpResultInfo"
+ Just (tc,_,_) -> ReturnsAlg tc
+ other -> ReturnsPrim other
+
+isCompareOp :: PrimOp -> Bool
+isCompareOp op
+ = case primOpInfo op of
+ Compare _ _ -> True
+ _ -> False
+\end{code}
+
+The commutable ops are those for which we will try to move constants
+to the right hand side for strength reduction.
+
+\begin{code}
+commutableOp :: PrimOp -> Bool
+
+commutableOp CharEqOp = True
+commutableOp CharNeOp = True
+commutableOp IntAddOp = True
+commutableOp IntMulOp = True
+commutableOp AndOp = True
+commutableOp OrOp = True
+commutableOp XorOp = True
+commutableOp IntEqOp = True
+commutableOp IntNeOp = True
+commutableOp IntegerAddOp = True
+commutableOp IntegerMulOp = True
+commutableOp IntegerGcdOp = True
+commutableOp FloatAddOp = True
+commutableOp FloatMulOp = True
+commutableOp FloatEqOp = True
+commutableOp FloatNeOp = True
+commutableOp DoubleAddOp = True
+commutableOp DoubleMulOp = True
+commutableOp DoubleEqOp = True
+commutableOp DoubleNeOp = True
+commutableOp _ = False
+\end{code}
+
+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
+\end{code}
+
+Output stuff:
+\begin{code}
+pprPrimOp :: PrimOp -> SDoc
+
+pprPrimOp (CCallOp fun is_casm may_gc cconv)
+ = let
+ callconv = text "{-" <> pprCallConv cconv <> text "-}"
+
+ before
+ | 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 _ -> text "\"\""
+ Left fn -> ptext fn
+
+ in
+ hcat [ ifPprDebug callconv
+ , text "__", ppr_dyn
+ , text before , ppr_fun , after]
+
+pprPrimOp other_op
+ = getPprStyle $ \ sty ->
+ if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
+ ptext SLIT("PrelGHC.") <> pprOccName occ
+ else
+ pprOccName occ
+ where
+ occ = primOpOcc other_op
+\end{code}