ghc/compiler/prelude/PrimOp.lhs

   1 %\r
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998\r
   3 %\r
   4 \section[PrimOp]{Primitive operations (machine-level)}\r
   5 \r
   6 \begin{code}\r
   7 module PrimOp (\r
   8         PrimOp(..), allThePrimOps,\r
   9         primOpType, primOpSig, primOpUsg,\r
  10         mkPrimOpIdName, primOpRdrName,\r
  11 \r
  12         commutableOp,\r
  13 \r
  14         primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,\r
  15         primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,\r
  16         primOpHasSideEffects,\r
  17 \r
  18         getPrimOpResultInfo,  PrimOpResultInfo(..),\r
  19 \r
  20         pprPrimOp\r
  21     ) where\r
  22 \r
  23 #include "HsVersions.h"\r
  24 \r
  25 import PrimRep          -- most of it\r
  26 import TysPrim\r
  27 import TysWiredIn\r
  28 \r
  29 import Demand           ( Demand, wwLazy, wwPrim, wwStrict )\r
  30 import Var              ( TyVar, Id )\r
  31 import CallConv         ( CallConv, pprCallConv )\r
  32 import PprType          ( pprParendType )\r
  33 import Name             ( Name, mkWiredInIdName )\r
  34 import RdrName          ( RdrName, mkRdrQual )\r
  35 import OccName          ( OccName, pprOccName, mkSrcVarOcc )\r
  36 import TyCon            ( TyCon, tyConArity )\r
  37 import Type             ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,\r
  38                           mkTyConTy, mkTyConApp, typePrimRep,\r
  39                           splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,\r
  40                           UsageAnn(..), mkUsgTy\r
  41                         )\r
  42 import Unique           ( Unique, mkPrimOpIdUnique )\r
  43 import PrelMods         ( pREL_GHC, pREL_GHC_Name )\r
  44 import Outputable\r
  45 import Util             ( assoc, zipWithEqual )\r
  46 import GlaExts          ( Int(..), Int#, (==#) )\r
  47 \end{code}\r
  48 \r
  49 %************************************************************************\r
  50 %*                                                                      *\r
  51 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}\r
  52 %*                                                                      *\r
  53 %************************************************************************\r
  54 \r
  55 These are in \tr{state-interface.verb} order.\r
  56 \r
  57 \begin{code}\r
  58 data PrimOp\r
  59     -- dig the FORTRAN/C influence on the names...\r
  60 \r
  61     -- comparisons:\r
  62 \r
  63     = CharGtOp   | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp\r
  64     | IntGtOp    | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp\r
  65     | WordGtOp   | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp\r
  66     | AddrGtOp   | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp\r
  67     | FloatGtOp  | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp\r
  68     | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp\r
  69 \r
  70     -- Char#-related ops:\r
  71     | OrdOp | ChrOp\r
  72 \r
  73     -- Int#-related ops:\r
  74    -- IntAbsOp unused?? ADR\r
  75     | IntAddOp | IntSubOp | IntMulOp | IntQuotOp\r
  76     | IntRemOp | IntNegOp | IntAbsOp\r
  77     | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}\r
  78     | IntAddCOp\r
  79     | IntSubCOp\r
  80     | IntMulCOp\r
  81 \r
  82     -- Word#-related ops:\r
  83     | WordQuotOp | WordRemOp\r
  84     | AndOp  | OrOp   | NotOp | XorOp\r
  85     | SllOp  | SrlOp  -- shift {left,right} {logical}\r
  86     | Int2WordOp | Word2IntOp -- casts\r
  87 \r
  88     -- Addr#-related ops:\r
  89     | Int2AddrOp | Addr2IntOp -- casts\r
  90 \r
  91     -- Float#-related ops:\r
  92     | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp\r
  93     | Float2IntOp | Int2FloatOp\r
  94 \r
  95     | FloatExpOp   | FloatLogOp   | FloatSqrtOp\r
  96     | FloatSinOp   | FloatCosOp   | FloatTanOp\r
  97     | FloatAsinOp  | FloatAcosOp  | FloatAtanOp\r
  98     | FloatSinhOp  | FloatCoshOp  | FloatTanhOp\r
  99     -- not all machines have these available conveniently:\r
 100     -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp\r
 101     | FloatPowerOp -- ** op\r
 102 \r
 103     -- Double#-related ops:\r
 104     | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp\r
 105     | Double2IntOp | Int2DoubleOp\r
 106     | Double2FloatOp | Float2DoubleOp\r
 107 \r
 108     | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp\r
 109     | DoubleSinOp   | DoubleCosOp   | DoubleTanOp\r
 110     | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp\r
 111     | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp\r
 112     -- not all machines have these available conveniently:\r
 113     -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp\r
 114     | DoublePowerOp -- ** op\r
 115 \r
 116     -- Integer (and related...) ops:\r
 117     -- slightly weird -- to match GMP package.\r
 118     | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp\r
 119     | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp\r
 120 \r
 121     | IntegerCmpOp\r
 122     | IntegerCmpIntOp\r
 123 \r
 124     | Integer2IntOp  | Integer2WordOp  \r
 125     | Int2IntegerOp  | Word2IntegerOp\r
 126     | Addr2IntegerOp\r
 127      -- casting to/from Integer and 64-bit (un)signed quantities.\r
 128     | IntegerToInt64Op | Int64ToIntegerOp\r
 129     | IntegerToWord64Op | Word64ToIntegerOp\r
 130     -- ?? gcd, etc?\r
 131 \r
 132     | FloatDecodeOp\r
 133     | DoubleDecodeOp\r
 134 \r
 135     -- primitive ops for primitive arrays\r
 136 \r
 137     | NewArrayOp\r
 138     | NewByteArrayOp PrimRep\r
 139 \r
 140     | SameMutableArrayOp\r
 141     | SameMutableByteArrayOp\r
 142 \r
 143     | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs\r
 144 \r
 145     | ReadByteArrayOp   PrimRep\r
 146     | WriteByteArrayOp  PrimRep\r
 147     | IndexByteArrayOp  PrimRep\r
 148     | IndexOffAddrOp    PrimRep\r
 149     | WriteOffAddrOp    PrimRep\r
 150         -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.\r
 151         -- This is just a cheesy encoding of a bunch of ops.\r
 152         -- Note that ForeignObjRep is not included -- the only way of\r
 153         -- creating a ForeignObj is with a ccall or casm.\r
 154     | IndexOffForeignObjOp PrimRep\r
 155 \r
 156     | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp\r
 157     | UnsafeThawArrayOp   | UnsafeThawByteArrayOp\r
 158     | SizeofByteArrayOp   | SizeofMutableByteArrayOp\r
 159 \r
 160     -- Mutable variables\r
 161     | NewMutVarOp\r
 162     | ReadMutVarOp\r
 163     | WriteMutVarOp\r
 164     | SameMutVarOp\r
 165 \r
 166     -- for MVars\r
 167     | NewMVarOp\r
 168     | TakeMVarOp \r
 169     | PutMVarOp\r
 170     | SameMVarOp\r
 171     | IsEmptyMVarOp\r
 172 \r
 173     -- exceptions\r
 174     | CatchOp\r
 175     | RaiseOp\r
 176 \r
 177     -- foreign objects\r
 178     | MakeForeignObjOp\r
 179     | WriteForeignObjOp\r
 180 \r
 181     -- weak pointers\r
 182     | MkWeakOp\r
 183     | DeRefWeakOp\r
 184     | FinalizeWeakOp\r
 185 \r
 186     -- stable names\r
 187     | MakeStableNameOp\r
 188     | EqStableNameOp\r
 189     | StableNameToIntOp\r
 190 \r
 191     -- stable pointers\r
 192     | MakeStablePtrOp\r
 193     | DeRefStablePtrOp\r
 194     | EqStablePtrOp\r
 195 \end{code}\r
 196 \r
 197 A special ``trap-door'' to use in making calls direct to C functions:\r
 198 \begin{code}\r
 199     | CCallOp   (Either \r
 200                     FAST_STRING    -- Left fn => An "unboxed" ccall# to `fn'.\r
 201                     Unique)        -- Right u => first argument (an Addr#) is the function pointer\r
 202                                    --   (unique is used to generate a 'typedef' to cast\r
 203                                    --    the function pointer if compiling the ccall# down to\r
 204                                    --    .hc code - can't do this inline for tedious reasons.)\r
 205                                     \r
 206                 Bool                -- True <=> really a "casm"\r
 207                 Bool                -- True <=> might invoke Haskell GC\r
 208                 CallConv            -- calling convention to use.\r
 209 \r
 210     -- (... to be continued ... )\r
 211 \end{code}\r
 212 \r
 213 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.\r
 214 (See @primOpInfo@ for details.)\r
 215 \r
 216 Note: that first arg and part of the result should be the system state\r
 217 token (which we carry around to fool over-zealous optimisers) but\r
 218 which isn't actually passed.\r
 219 \r
 220 For example, we represent\r
 221 \begin{pseudocode}\r
 222 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)\r
 223 \end{pseudocode}\r
 224 by\r
 225 \begin{pseudocode}\r
 226 Case\r
 227   ( Prim\r
 228       (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)\r
 229        -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse\r
 230       []\r
 231       [w#, sp# i#]\r
 232   )\r
 233   (AlgAlts [ ( FloatPrimAndIoWorld,\r
 234                  [f#, w#],\r
 235                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]\r
 236                ) ]\r
 237              NoDefault\r
 238   )\r
 239 \end{pseudocode}\r
 240 \r
 241 Nota Bene: there are some people who find the empty list of types in\r
 242 the @Prim@ somewhat puzzling and would represent the above by\r
 243 \begin{pseudocode}\r
 244 Case\r
 245   ( Prim\r
 246       (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)\r
 247        -- :: /\ alpha1, alpha2 alpha3, alpha4.\r
 248        --       alpha1 -> alpha2 -> alpha3 -> alpha4\r
 249       [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]\r
 250       [w#, sp# i#]\r
 251   )\r
 252   (AlgAlts [ ( FloatPrimAndIoWorld,\r
 253                  [f#, w#],\r
 254                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]\r
 255                ) ]\r
 256              NoDefault\r
 257   )\r
 258 \end{pseudocode}\r
 259 \r
 260 But, this is a completely different way of using @CCallOp@.  The most\r
 261 major changes required if we switch to this are in @primOpInfo@, and\r
 262 the desugarer. The major difficulty is in moving the HeapRequirement\r
 263 stuff somewhere appropriate.  (The advantage is that we could simplify\r
 264 @CCallOp@ and record just the number of arguments with corresponding\r
 265 simplifications in reading pragma unfoldings, the simplifier,\r
 266 instantiation (etc) of core expressions, ... .  Maybe we should think\r
 267 about using it this way?? ADR)\r
 268 \r
 269 \begin{code}\r
 270     -- (... continued from above ... )\r
 271 \r
 272     -- Operation to test two closure addresses for equality (yes really!)\r
 273     -- BLAME ALASTAIR REID FOR THIS!  THE REST OF US ARE INNOCENT!\r
 274     | ReallyUnsafePtrEqualityOp\r
 275 \r
 276     -- parallel stuff\r
 277     | SeqOp\r
 278     | ParOp\r
 279 \r
 280     -- concurrency\r
 281     | ForkOp\r
 282     | KillThreadOp\r
 283     | YieldOp\r
 284     | MyThreadIdOp\r
 285     | DelayOp\r
 286     | WaitReadOp\r
 287     | WaitWriteOp\r
 288 \r
 289     -- more parallel stuff\r
 290     | ParGlobalOp       -- named global par\r
 291     | ParLocalOp        -- named local par\r
 292     | ParAtOp           -- specifies destination of local par\r
 293     | ParAtAbsOp        -- specifies destination of local par (abs processor)\r
 294     | ParAtRelOp        -- specifies destination of local par (rel processor)\r
 295     | ParAtForNowOp     -- specifies initial destination of global par\r
 296     | CopyableOp        -- marks copyable code\r
 297     | NoFollowOp        -- marks non-followup expression\r
 298 \r
 299     -- tag-related\r
 300     | DataToTagOp\r
 301     | TagToEnumOp\r
 302 \end{code}\r
 303 \r
 304 Used for the Ord instance\r
 305 \r
 306 \begin{code}\r
 307 tagOf_PrimOp CharGtOp                         = (ILIT( 1) :: FAST_INT)\r
 308 tagOf_PrimOp CharGeOp                         = ILIT(  2)\r
 309 tagOf_PrimOp CharEqOp                         = ILIT(  3)\r
 310 tagOf_PrimOp CharNeOp                         = ILIT(  4)\r
 311 tagOf_PrimOp CharLtOp                         = ILIT(  5)\r
 312 tagOf_PrimOp CharLeOp                         = ILIT(  6)\r
 313 tagOf_PrimOp IntGtOp                          = ILIT(  7)\r
 314 tagOf_PrimOp IntGeOp                          = ILIT(  8)\r
 315 tagOf_PrimOp IntEqOp                          = ILIT(  9)\r
 316 tagOf_PrimOp IntNeOp                          = ILIT( 10)\r
 317 tagOf_PrimOp IntLtOp                          = ILIT( 11)\r
 318 tagOf_PrimOp IntLeOp                          = ILIT( 12)\r
 319 tagOf_PrimOp WordGtOp                         = ILIT( 13)\r
 320 tagOf_PrimOp WordGeOp                         = ILIT( 14)\r
 321 tagOf_PrimOp WordEqOp                         = ILIT( 15)\r
 322 tagOf_PrimOp WordNeOp                         = ILIT( 16)\r
 323 tagOf_PrimOp WordLtOp                         = ILIT( 17)\r
 324 tagOf_PrimOp WordLeOp                         = ILIT( 18)\r
 325 tagOf_PrimOp AddrGtOp                         = ILIT( 19)\r
 326 tagOf_PrimOp AddrGeOp                         = ILIT( 20)\r
 327 tagOf_PrimOp AddrEqOp                         = ILIT( 21)\r
 328 tagOf_PrimOp AddrNeOp                         = ILIT( 22)\r
 329 tagOf_PrimOp AddrLtOp                         = ILIT( 23)\r
 330 tagOf_PrimOp AddrLeOp                         = ILIT( 24)\r
 331 tagOf_PrimOp FloatGtOp                        = ILIT( 25)\r
 332 tagOf_PrimOp FloatGeOp                        = ILIT( 26)\r
 333 tagOf_PrimOp FloatEqOp                        = ILIT( 27)\r
 334 tagOf_PrimOp FloatNeOp                        = ILIT( 28)\r
 335 tagOf_PrimOp FloatLtOp                        = ILIT( 29)\r
 336 tagOf_PrimOp FloatLeOp                        = ILIT( 30)\r
 337 tagOf_PrimOp DoubleGtOp                       = ILIT( 31)\r
 338 tagOf_PrimOp DoubleGeOp                       = ILIT( 32)\r
 339 tagOf_PrimOp DoubleEqOp                       = ILIT( 33)\r
 340 tagOf_PrimOp DoubleNeOp                       = ILIT( 34)\r
 341 tagOf_PrimOp DoubleLtOp                       = ILIT( 35)\r
 342 tagOf_PrimOp DoubleLeOp                       = ILIT( 36)\r
 343 tagOf_PrimOp OrdOp                            = ILIT( 37)\r
 344 tagOf_PrimOp ChrOp                            = ILIT( 38)\r
 345 tagOf_PrimOp IntAddOp                         = ILIT( 39)\r
 346 tagOf_PrimOp IntSubOp                         = ILIT( 40)\r
 347 tagOf_PrimOp IntMulOp                         = ILIT( 41)\r
 348 tagOf_PrimOp IntQuotOp                        = ILIT( 42)\r
 349 tagOf_PrimOp IntRemOp                         = ILIT( 43)\r
 350 tagOf_PrimOp IntNegOp                         = ILIT( 44)\r
 351 tagOf_PrimOp IntAbsOp                         = ILIT( 45)\r
 352 tagOf_PrimOp WordQuotOp                       = ILIT( 46)\r
 353 tagOf_PrimOp WordRemOp                        = ILIT( 47)\r
 354 tagOf_PrimOp AndOp                            = ILIT( 48)\r
 355 tagOf_PrimOp OrOp                             = ILIT( 49)\r
 356 tagOf_PrimOp NotOp                            = ILIT( 50)\r
 357 tagOf_PrimOp XorOp                            = ILIT( 51)\r
 358 tagOf_PrimOp SllOp                            = ILIT( 52)\r
 359 tagOf_PrimOp SrlOp                            = ILIT( 53)\r
 360 tagOf_PrimOp ISllOp                           = ILIT( 54)\r
 361 tagOf_PrimOp ISraOp                           = ILIT( 55)\r
 362 tagOf_PrimOp ISrlOp                           = ILIT( 56)\r
 363 tagOf_PrimOp IntAddCOp                        = ILIT( 57)\r
 364 tagOf_PrimOp IntSubCOp                        = ILIT( 58)\r
 365 tagOf_PrimOp IntMulCOp                        = ILIT( 59)\r
 366 tagOf_PrimOp Int2WordOp                       = ILIT( 60)\r
 367 tagOf_PrimOp Word2IntOp                       = ILIT( 61)\r
 368 tagOf_PrimOp Int2AddrOp                       = ILIT( 62)\r
 369 tagOf_PrimOp Addr2IntOp                       = ILIT( 63)\r
 370 \r
 371 tagOf_PrimOp FloatAddOp                       = ILIT( 64)\r
 372 tagOf_PrimOp FloatSubOp                       = ILIT( 65)\r
 373 tagOf_PrimOp FloatMulOp                       = ILIT( 66)\r
 374 tagOf_PrimOp FloatDivOp                       = ILIT( 67)\r
 375 tagOf_PrimOp FloatNegOp                       = ILIT( 68)\r
 376 tagOf_PrimOp Float2IntOp                      = ILIT( 69)\r
 377 tagOf_PrimOp Int2FloatOp                      = ILIT( 70)\r
 378 tagOf_PrimOp FloatExpOp                       = ILIT( 71)\r
 379 tagOf_PrimOp FloatLogOp                       = ILIT( 72)\r
 380 tagOf_PrimOp FloatSqrtOp                      = ILIT( 73)\r
 381 tagOf_PrimOp FloatSinOp                       = ILIT( 74)\r
 382 tagOf_PrimOp FloatCosOp                       = ILIT( 75)\r
 383 tagOf_PrimOp FloatTanOp                       = ILIT( 76)\r
 384 tagOf_PrimOp FloatAsinOp                      = ILIT( 77)\r
 385 tagOf_PrimOp FloatAcosOp                      = ILIT( 78)\r
 386 tagOf_PrimOp FloatAtanOp                      = ILIT( 79)\r
 387 tagOf_PrimOp FloatSinhOp                      = ILIT( 80)\r
 388 tagOf_PrimOp FloatCoshOp                      = ILIT( 81)\r
 389 tagOf_PrimOp FloatTanhOp                      = ILIT( 82)\r
 390 tagOf_PrimOp FloatPowerOp                     = ILIT( 83)\r
 391 \r
 392 tagOf_PrimOp DoubleAddOp                      = ILIT( 84)\r
 393 tagOf_PrimOp DoubleSubOp                      = ILIT( 85)\r
 394 tagOf_PrimOp DoubleMulOp                      = ILIT( 86)\r
 395 tagOf_PrimOp DoubleDivOp                      = ILIT( 87)\r
 396 tagOf_PrimOp DoubleNegOp                      = ILIT( 88)\r
 397 tagOf_PrimOp Double2IntOp                     = ILIT( 89)\r
 398 tagOf_PrimOp Int2DoubleOp                     = ILIT( 90)\r
 399 tagOf_PrimOp Double2FloatOp                   = ILIT( 91)\r
 400 tagOf_PrimOp Float2DoubleOp                   = ILIT( 92)\r
 401 tagOf_PrimOp DoubleExpOp                      = ILIT( 93)\r
 402 tagOf_PrimOp DoubleLogOp                      = ILIT( 94)\r
 403 tagOf_PrimOp DoubleSqrtOp                     = ILIT( 95)\r
 404 tagOf_PrimOp DoubleSinOp                      = ILIT( 96)\r
 405 tagOf_PrimOp DoubleCosOp                      = ILIT( 97)\r
 406 tagOf_PrimOp DoubleTanOp                      = ILIT( 98)\r
 407 tagOf_PrimOp DoubleAsinOp                     = ILIT( 99)\r
 408 tagOf_PrimOp DoubleAcosOp                     = ILIT(100)\r
 409 tagOf_PrimOp DoubleAtanOp                     = ILIT(101)\r
 410 tagOf_PrimOp DoubleSinhOp                     = ILIT(102)\r
 411 tagOf_PrimOp DoubleCoshOp                     = ILIT(103)\r
 412 tagOf_PrimOp DoubleTanhOp                     = ILIT(104)\r
 413 tagOf_PrimOp DoublePowerOp                    = ILIT(105)\r
 414 \r
 415 tagOf_PrimOp IntegerAddOp                     = ILIT(106)\r
 416 tagOf_PrimOp IntegerSubOp                     = ILIT(107)\r
 417 tagOf_PrimOp IntegerMulOp                     = ILIT(108)\r
 418 tagOf_PrimOp IntegerGcdOp                     = ILIT(109)\r
 419 tagOf_PrimOp IntegerQuotRemOp                 = ILIT(110)\r
 420 tagOf_PrimOp IntegerDivModOp                  = ILIT(111)\r
 421 tagOf_PrimOp IntegerNegOp                     = ILIT(112)\r
 422 tagOf_PrimOp IntegerCmpOp                     = ILIT(113)\r
 423 tagOf_PrimOp IntegerCmpIntOp                  = ILIT(114)\r
 424 tagOf_PrimOp Integer2IntOp                    = ILIT(115)\r
 425 tagOf_PrimOp Integer2WordOp                   = ILIT(116)\r
 426 tagOf_PrimOp Int2IntegerOp                    = ILIT(117)\r
 427 tagOf_PrimOp Word2IntegerOp                   = ILIT(118)\r
 428 tagOf_PrimOp Addr2IntegerOp                   = ILIT(119)\r
 429 tagOf_PrimOp IntegerToInt64Op                 = ILIT(120)\r
 430 tagOf_PrimOp Int64ToIntegerOp                 = ILIT(121)\r
 431 tagOf_PrimOp IntegerToWord64Op                = ILIT(122)\r
 432 tagOf_PrimOp Word64ToIntegerOp                = ILIT(123)\r
 433 tagOf_PrimOp FloatDecodeOp                    = ILIT(125)\r
 434 tagOf_PrimOp DoubleDecodeOp                   = ILIT(127)\r
 435 \r
 436 tagOf_PrimOp NewArrayOp                       = ILIT(128)\r
 437 tagOf_PrimOp (NewByteArrayOp CharRep)         = ILIT(129)\r
 438 tagOf_PrimOp (NewByteArrayOp IntRep)          = ILIT(130)\r
 439 tagOf_PrimOp (NewByteArrayOp WordRep)         = ILIT(131)\r
 440 tagOf_PrimOp (NewByteArrayOp AddrRep)         = ILIT(132)\r
 441 tagOf_PrimOp (NewByteArrayOp FloatRep)        = ILIT(133)\r
 442 tagOf_PrimOp (NewByteArrayOp DoubleRep)       = ILIT(134)\r
 443 tagOf_PrimOp (NewByteArrayOp StablePtrRep)    = ILIT(135)\r
 444 \r
 445 tagOf_PrimOp SameMutableArrayOp               = ILIT(136)\r
 446 tagOf_PrimOp SameMutableByteArrayOp           = ILIT(137)\r
 447 tagOf_PrimOp ReadArrayOp                      = ILIT(138)\r
 448 tagOf_PrimOp WriteArrayOp                     = ILIT(139)\r
 449 tagOf_PrimOp IndexArrayOp                     = ILIT(140)\r
 450 \r
 451 tagOf_PrimOp (ReadByteArrayOp CharRep)        = ILIT(141)\r
 452 tagOf_PrimOp (ReadByteArrayOp IntRep)         = ILIT(142)\r
 453 tagOf_PrimOp (ReadByteArrayOp WordRep)        = ILIT(143)\r
 454 tagOf_PrimOp (ReadByteArrayOp AddrRep)        = ILIT(144)\r
 455 tagOf_PrimOp (ReadByteArrayOp FloatRep)       = ILIT(145)\r
 456 tagOf_PrimOp (ReadByteArrayOp DoubleRep)      = ILIT(146)\r
 457 tagOf_PrimOp (ReadByteArrayOp StablePtrRep)   = ILIT(147)\r
 458 tagOf_PrimOp (ReadByteArrayOp Int64Rep)       = ILIT(148)\r
 459 tagOf_PrimOp (ReadByteArrayOp Word64Rep)      = ILIT(149)\r
 460 \r
 461 tagOf_PrimOp (WriteByteArrayOp CharRep)       = ILIT(150)\r
 462 tagOf_PrimOp (WriteByteArrayOp IntRep)        = ILIT(151)\r
 463 tagOf_PrimOp (WriteByteArrayOp WordRep)       = ILIT(152)\r
 464 tagOf_PrimOp (WriteByteArrayOp AddrRep)       = ILIT(153)\r
 465 tagOf_PrimOp (WriteByteArrayOp FloatRep)      = ILIT(154)\r
 466 tagOf_PrimOp (WriteByteArrayOp DoubleRep)     = ILIT(155)\r
 467 tagOf_PrimOp (WriteByteArrayOp StablePtrRep)  = ILIT(156)\r
 468 tagOf_PrimOp (WriteByteArrayOp Int64Rep)      = ILIT(157)\r
 469 tagOf_PrimOp (WriteByteArrayOp Word64Rep)     = ILIT(158)\r
 470 \r
 471 tagOf_PrimOp (IndexByteArrayOp CharRep)       = ILIT(159)\r
 472 tagOf_PrimOp (IndexByteArrayOp IntRep)        = ILIT(160)\r
 473 tagOf_PrimOp (IndexByteArrayOp WordRep)       = ILIT(161)\r
 474 tagOf_PrimOp (IndexByteArrayOp AddrRep)       = ILIT(162)\r
 475 tagOf_PrimOp (IndexByteArrayOp FloatRep)      = ILIT(163)\r
 476 tagOf_PrimOp (IndexByteArrayOp DoubleRep)     = ILIT(164)\r
 477 tagOf_PrimOp (IndexByteArrayOp StablePtrRep)  = ILIT(165)\r
 478 tagOf_PrimOp (IndexByteArrayOp Int64Rep)      = ILIT(166)\r
 479 tagOf_PrimOp (IndexByteArrayOp Word64Rep)     = ILIT(167)\r
 480 \r
 481 tagOf_PrimOp (IndexOffAddrOp CharRep)         = ILIT(168)\r
 482 tagOf_PrimOp (IndexOffAddrOp IntRep)          = ILIT(169)\r
 483 tagOf_PrimOp (IndexOffAddrOp WordRep)         = ILIT(170)\r
 484 tagOf_PrimOp (IndexOffAddrOp AddrRep)         = ILIT(171)\r
 485 tagOf_PrimOp (IndexOffAddrOp FloatRep)        = ILIT(172)\r
 486 tagOf_PrimOp (IndexOffAddrOp DoubleRep)       = ILIT(173)\r
 487 tagOf_PrimOp (IndexOffAddrOp StablePtrRep)    = ILIT(174)\r
 488 tagOf_PrimOp (IndexOffAddrOp Int64Rep)        = ILIT(175)\r
 489 tagOf_PrimOp (IndexOffAddrOp Word64Rep)       = ILIT(176)\r
 490 \r
 491 tagOf_PrimOp (IndexOffForeignObjOp CharRep)   = ILIT(177)\r
 492 tagOf_PrimOp (IndexOffForeignObjOp IntRep)    = ILIT(178)\r
 493 tagOf_PrimOp (IndexOffForeignObjOp WordRep)   = ILIT(179)\r
 494 tagOf_PrimOp (IndexOffForeignObjOp AddrRep)   = ILIT(180)\r
 495 tagOf_PrimOp (IndexOffForeignObjOp FloatRep)  = ILIT(181)\r
 496 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)\r
 497 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)\r
 498 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep)  = ILIT(184)\r
 499 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)\r
 500 \r
 501 tagOf_PrimOp (WriteOffAddrOp CharRep)         = ILIT(186)\r
 502 tagOf_PrimOp (WriteOffAddrOp IntRep)          = ILIT(187)\r
 503 tagOf_PrimOp (WriteOffAddrOp WordRep)         = ILIT(188)\r
 504 tagOf_PrimOp (WriteOffAddrOp AddrRep)         = ILIT(189)\r
 505 tagOf_PrimOp (WriteOffAddrOp FloatRep)        = ILIT(190)\r
 506 tagOf_PrimOp (WriteOffAddrOp DoubleRep)       = ILIT(191)\r
 507 tagOf_PrimOp (WriteOffAddrOp StablePtrRep)    = ILIT(192)\r
 508 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep)   = ILIT(193)\r
 509 tagOf_PrimOp (WriteOffAddrOp Int64Rep)        = ILIT(194)\r
 510 tagOf_PrimOp (WriteOffAddrOp Word64Rep)       = ILIT(195)\r
 511 \r
 512 tagOf_PrimOp UnsafeFreezeArrayOp              = ILIT(196)\r
 513 tagOf_PrimOp UnsafeFreezeByteArrayOp          = ILIT(197)\r
 514 tagOf_PrimOp UnsafeThawArrayOp                = ILIT(198)\r
 515 tagOf_PrimOp UnsafeThawByteArrayOp            = ILIT(199)\r
 516 tagOf_PrimOp SizeofByteArrayOp                = ILIT(200)\r
 517 tagOf_PrimOp SizeofMutableByteArrayOp         = ILIT(201)\r
 518 \r
 519 tagOf_PrimOp NewMVarOp                        = ILIT(202)\r
 520 tagOf_PrimOp TakeMVarOp                       = ILIT(203)\r
 521 tagOf_PrimOp PutMVarOp                        = ILIT(204)\r
 522 tagOf_PrimOp SameMVarOp                       = ILIT(205)\r
 523 tagOf_PrimOp IsEmptyMVarOp                    = ILIT(206)\r
 524 tagOf_PrimOp MakeForeignObjOp                 = ILIT(207)\r
 525 tagOf_PrimOp WriteForeignObjOp                = ILIT(208)\r
 526 tagOf_PrimOp MkWeakOp                         = ILIT(209)\r
 527 tagOf_PrimOp DeRefWeakOp                      = ILIT(210)\r
 528 tagOf_PrimOp FinalizeWeakOp                   = ILIT(211)\r
 529 tagOf_PrimOp MakeStableNameOp                 = ILIT(212)\r
 530 tagOf_PrimOp EqStableNameOp                   = ILIT(213)\r
 531 tagOf_PrimOp StableNameToIntOp                = ILIT(214)\r
 532 tagOf_PrimOp MakeStablePtrOp                  = ILIT(215)\r
 533 tagOf_PrimOp DeRefStablePtrOp                 = ILIT(216)\r
 534 tagOf_PrimOp EqStablePtrOp                    = ILIT(217)\r
 535 tagOf_PrimOp (CCallOp _ _ _ _)                = ILIT(218)\r
 536 tagOf_PrimOp ReallyUnsafePtrEqualityOp        = ILIT(219)\r
 537 tagOf_PrimOp SeqOp                            = ILIT(220)\r
 538 tagOf_PrimOp ParOp                            = ILIT(221)\r
 539 tagOf_PrimOp ForkOp                           = ILIT(222)\r
 540 tagOf_PrimOp KillThreadOp                     = ILIT(223)\r
 541 tagOf_PrimOp YieldOp                          = ILIT(224)\r
 542 tagOf_PrimOp MyThreadIdOp                     = ILIT(225)\r
 543 tagOf_PrimOp DelayOp                          = ILIT(226)\r
 544 tagOf_PrimOp WaitReadOp                       = ILIT(227)\r
 545 tagOf_PrimOp WaitWriteOp                      = ILIT(228)\r
 546 tagOf_PrimOp ParGlobalOp                      = ILIT(229)\r
 547 tagOf_PrimOp ParLocalOp                       = ILIT(230)\r
 548 tagOf_PrimOp ParAtOp                          = ILIT(231)\r
 549 tagOf_PrimOp ParAtAbsOp                       = ILIT(232)\r
 550 tagOf_PrimOp ParAtRelOp                       = ILIT(233)\r
 551 tagOf_PrimOp ParAtForNowOp                    = ILIT(234)\r
 552 tagOf_PrimOp CopyableOp                       = ILIT(235)\r
 553 tagOf_PrimOp NoFollowOp                       = ILIT(236)\r
 554 tagOf_PrimOp NewMutVarOp                      = ILIT(237)\r
 555 tagOf_PrimOp ReadMutVarOp                     = ILIT(238)\r
 556 tagOf_PrimOp WriteMutVarOp                    = ILIT(239)\r
 557 tagOf_PrimOp SameMutVarOp                     = ILIT(240)\r
 558 tagOf_PrimOp CatchOp                          = ILIT(241)\r
 559 tagOf_PrimOp RaiseOp                          = ILIT(242)\r
 560 tagOf_PrimOp DataToTagOp                      = ILIT(243)\r
 561 tagOf_PrimOp TagToEnumOp                      = ILIT(244)\r
 562 \r
 563 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)\r
 564 --panic# "tagOf_PrimOp: pattern-match"\r
 565 \r
 566 instance Eq PrimOp where\r
 567     op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2\r
 568 \r
 569 instance Ord PrimOp where\r
 570     op1 <  op2 =  tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2\r
 571     op1 <= op2 =  tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2\r
 572     op1 >= op2 =  tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2\r
 573     op1 >  op2 =  tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2\r
 574     op1 `compare` op2 | op1 < op2  = LT\r
 575                       | op1 == op2 = EQ\r
 576                       | otherwise  = GT\r
 577 \r
 578 instance Outputable PrimOp where\r
 579     ppr op = pprPrimOp op\r
 580 \r
 581 instance Show PrimOp where\r
 582     showsPrec p op = showsPrecSDoc p (pprPrimOp op)\r
 583 \end{code}\r
 584 \r
 585 An @Enum@-derived list would be better; meanwhile... (ToDo)\r
 586 \begin{code}\r
 587 allThePrimOps\r
 588   = [   CharGtOp,\r
 589         CharGeOp,\r
 590         CharEqOp,\r
 591         CharNeOp,\r
 592         CharLtOp,\r
 593         CharLeOp,\r
 594         IntGtOp,\r
 595         IntGeOp,\r
 596         IntEqOp,\r
 597         IntNeOp,\r
 598         IntLtOp,\r
 599         IntLeOp,\r
 600         WordGtOp,\r
 601         WordGeOp,\r
 602         WordEqOp,\r
 603         WordNeOp,\r
 604         WordLtOp,\r
 605         WordLeOp,\r
 606         AddrGtOp,\r
 607         AddrGeOp,\r
 608         AddrEqOp,\r
 609         AddrNeOp,\r
 610         AddrLtOp,\r
 611         AddrLeOp,\r
 612         FloatGtOp,\r
 613         FloatGeOp,\r
 614         FloatEqOp,\r
 615         FloatNeOp,\r
 616         FloatLtOp,\r
 617         FloatLeOp,\r
 618         DoubleGtOp,\r
 619         DoubleGeOp,\r
 620         DoubleEqOp,\r
 621         DoubleNeOp,\r
 622         DoubleLtOp,\r
 623         DoubleLeOp,\r
 624         OrdOp,\r
 625         ChrOp,\r
 626         IntAddOp,\r
 627         IntSubOp,\r
 628         IntMulOp,\r
 629         IntQuotOp,\r
 630         IntRemOp,\r
 631         IntNegOp,\r
 632         WordQuotOp,\r
 633         WordRemOp,\r
 634         AndOp,\r
 635         OrOp,\r
 636         NotOp,\r
 637         XorOp,\r
 638         SllOp,\r
 639         SrlOp,\r
 640         ISllOp,\r
 641         ISraOp,\r
 642         ISrlOp,\r
 643         IntAddCOp,\r
 644         IntSubCOp,\r
 645         IntMulCOp,\r
 646         Int2WordOp,\r
 647         Word2IntOp,\r
 648         Int2AddrOp,\r
 649         Addr2IntOp,\r
 650 \r
 651         FloatAddOp,\r
 652         FloatSubOp,\r
 653         FloatMulOp,\r
 654         FloatDivOp,\r
 655         FloatNegOp,\r
 656         Float2IntOp,\r
 657         Int2FloatOp,\r
 658         FloatExpOp,\r
 659         FloatLogOp,\r
 660         FloatSqrtOp,\r
 661         FloatSinOp,\r
 662         FloatCosOp,\r
 663         FloatTanOp,\r
 664         FloatAsinOp,\r
 665         FloatAcosOp,\r
 666         FloatAtanOp,\r
 667         FloatSinhOp,\r
 668         FloatCoshOp,\r
 669         FloatTanhOp,\r
 670         FloatPowerOp,\r
 671         DoubleAddOp,\r
 672         DoubleSubOp,\r
 673         DoubleMulOp,\r
 674         DoubleDivOp,\r
 675         DoubleNegOp,\r
 676         Double2IntOp,\r
 677         Int2DoubleOp,\r
 678         Double2FloatOp,\r
 679         Float2DoubleOp,\r
 680         DoubleExpOp,\r
 681         DoubleLogOp,\r
 682         DoubleSqrtOp,\r
 683         DoubleSinOp,\r
 684         DoubleCosOp,\r
 685         DoubleTanOp,\r
 686         DoubleAsinOp,\r
 687         DoubleAcosOp,\r
 688         DoubleAtanOp,\r
 689         DoubleSinhOp,\r
 690         DoubleCoshOp,\r
 691         DoubleTanhOp,\r
 692         DoublePowerOp,\r
 693         IntegerAddOp,\r
 694         IntegerSubOp,\r
 695         IntegerMulOp,\r
 696         IntegerGcdOp,\r
 697         IntegerQuotRemOp,\r
 698         IntegerDivModOp,\r
 699         IntegerNegOp,\r
 700         IntegerCmpOp,\r
 701         IntegerCmpIntOp,\r
 702         Integer2IntOp,\r
 703         Integer2WordOp,\r
 704         Int2IntegerOp,\r
 705         Word2IntegerOp,\r
 706         Addr2IntegerOp,\r
 707         IntegerToInt64Op,\r
 708         Int64ToIntegerOp,\r
 709         IntegerToWord64Op,\r
 710         Word64ToIntegerOp,\r
 711         FloatDecodeOp,\r
 712         DoubleDecodeOp,\r
 713         NewArrayOp,\r
 714         NewByteArrayOp CharRep,\r
 715         NewByteArrayOp IntRep,\r
 716         NewByteArrayOp WordRep,\r
 717         NewByteArrayOp AddrRep,\r
 718         NewByteArrayOp FloatRep,\r
 719         NewByteArrayOp DoubleRep,\r
 720         NewByteArrayOp StablePtrRep,\r
 721         SameMutableArrayOp,\r
 722         SameMutableByteArrayOp,\r
 723         ReadArrayOp,\r
 724         WriteArrayOp,\r
 725         IndexArrayOp,\r
 726         ReadByteArrayOp CharRep,\r
 727         ReadByteArrayOp IntRep,\r
 728         ReadByteArrayOp WordRep,\r
 729         ReadByteArrayOp AddrRep,\r
 730         ReadByteArrayOp FloatRep,\r
 731         ReadByteArrayOp DoubleRep,\r
 732         ReadByteArrayOp StablePtrRep,\r
 733         ReadByteArrayOp Int64Rep,\r
 734         ReadByteArrayOp Word64Rep,\r
 735         WriteByteArrayOp CharRep,\r
 736         WriteByteArrayOp IntRep,\r
 737         WriteByteArrayOp WordRep,\r
 738         WriteByteArrayOp AddrRep,\r
 739         WriteByteArrayOp FloatRep,\r
 740         WriteByteArrayOp DoubleRep,\r
 741         WriteByteArrayOp StablePtrRep,\r
 742         WriteByteArrayOp Int64Rep,\r
 743         WriteByteArrayOp Word64Rep,\r
 744         IndexByteArrayOp CharRep,\r
 745         IndexByteArrayOp IntRep,\r
 746         IndexByteArrayOp WordRep,\r
 747         IndexByteArrayOp AddrRep,\r
 748         IndexByteArrayOp FloatRep,\r
 749         IndexByteArrayOp DoubleRep,\r
 750         IndexByteArrayOp StablePtrRep,\r
 751         IndexByteArrayOp Int64Rep,\r
 752         IndexByteArrayOp Word64Rep,\r
 753         IndexOffForeignObjOp CharRep,\r
 754         IndexOffForeignObjOp AddrRep,\r
 755         IndexOffForeignObjOp IntRep,\r
 756         IndexOffForeignObjOp WordRep,\r
 757         IndexOffForeignObjOp FloatRep,\r
 758         IndexOffForeignObjOp DoubleRep,\r
 759         IndexOffForeignObjOp StablePtrRep,\r
 760         IndexOffForeignObjOp Int64Rep,\r
 761         IndexOffForeignObjOp Word64Rep,\r
 762         IndexOffAddrOp CharRep,\r
 763         IndexOffAddrOp IntRep,\r
 764         IndexOffAddrOp WordRep,\r
 765         IndexOffAddrOp AddrRep,\r
 766         IndexOffAddrOp FloatRep,\r
 767         IndexOffAddrOp DoubleRep,\r
 768         IndexOffAddrOp StablePtrRep,\r
 769         IndexOffAddrOp Int64Rep,\r
 770         IndexOffAddrOp Word64Rep,\r
 771         WriteOffAddrOp CharRep,\r
 772         WriteOffAddrOp IntRep,\r
 773         WriteOffAddrOp WordRep,\r
 774         WriteOffAddrOp AddrRep,\r
 775         WriteOffAddrOp FloatRep,\r
 776         WriteOffAddrOp DoubleRep,\r
 777         WriteOffAddrOp ForeignObjRep,\r
 778         WriteOffAddrOp StablePtrRep,\r
 779         WriteOffAddrOp Int64Rep,\r
 780         WriteOffAddrOp Word64Rep,\r
 781         UnsafeFreezeArrayOp,\r
 782         UnsafeFreezeByteArrayOp,\r
 783         UnsafeThawArrayOp,\r
 784         UnsafeThawByteArrayOp,\r
 785         SizeofByteArrayOp,\r
 786         SizeofMutableByteArrayOp,\r
 787         NewMutVarOp,\r
 788         ReadMutVarOp,\r
 789         WriteMutVarOp,\r
 790         SameMutVarOp,\r
 791         CatchOp,\r
 792         RaiseOp,\r
 793         NewMVarOp,\r
 794         TakeMVarOp,\r
 795         PutMVarOp,\r
 796         SameMVarOp,\r
 797         IsEmptyMVarOp,\r
 798         MakeForeignObjOp,\r
 799         WriteForeignObjOp,\r
 800         MkWeakOp,\r
 801         DeRefWeakOp,\r
 802         FinalizeWeakOp,\r
 803         MakeStableNameOp,\r
 804         EqStableNameOp,\r
 805         StableNameToIntOp,\r
 806         MakeStablePtrOp,\r
 807         DeRefStablePtrOp,\r
 808         EqStablePtrOp,\r
 809         ReallyUnsafePtrEqualityOp,\r
 810         ParGlobalOp,\r
 811         ParLocalOp,\r
 812         ParAtOp,\r
 813         ParAtAbsOp,\r
 814         ParAtRelOp,\r
 815         ParAtForNowOp,\r
 816         CopyableOp,\r
 817         NoFollowOp,\r
 818         SeqOp,\r
 819         ParOp,\r
 820         ForkOp,\r
 821         KillThreadOp,\r
 822         YieldOp,\r
 823         MyThreadIdOp,\r
 824         DelayOp,\r
 825         WaitReadOp,\r
 826         WaitWriteOp,\r
 827         DataToTagOp,\r
 828         TagToEnumOp\r
 829     ]\r
 830 \end{code}\r
 831 \r
 832 %************************************************************************\r
 833 %*                                                                      *\r
 834 \subsection[PrimOp-info]{The essential info about each @PrimOp@}\r
 835 %*                                                                      *\r
 836 %************************************************************************\r
 837 \r
 838 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may\r
 839 refer to the primitive operation.  The conventional \tr{#}-for-\r
 840 unboxed ops is added on later.\r
 841 \r
 842 The reason for the funny characters in the names is so we do not\r
 843 interfere with the programmer's Haskell name spaces.\r
 844 \r
 845 We use @PrimKinds@ for the ``type'' information, because they're\r
 846 (slightly) more convenient to use than @TyCons@.\r
 847 \begin{code}\r
 848 data PrimOpInfo\r
 849   = Dyadic      OccName         -- string :: T -> T -> T\r
 850                 Type\r
 851   | Monadic     OccName         -- string :: T -> T\r
 852                 Type\r
 853   | Compare     OccName         -- string :: T -> T -> Bool\r
 854                 Type\r
 855 \r
 856   | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T\r
 857                 [TyVar] \r
 858                 [Type] \r
 859                 Type \r
 860 \r
 861 mkDyadic str  ty = Dyadic  (mkSrcVarOcc str) ty\r
 862 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty\r
 863 mkCompare str ty = Compare (mkSrcVarOcc str) ty\r
 864 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty\r
 865 \end{code}\r
 866 \r
 867 Utility bits:\r
 868 \begin{code}\r
 869 one_Integer_ty = [intPrimTy, byteArrayPrimTy]\r
 870 two_Integer_tys\r
 871   = [intPrimTy, byteArrayPrimTy, -- first Integer pieces\r
 872      intPrimTy, byteArrayPrimTy] -- second '' pieces\r
 873 an_Integer_and_Int_tys\r
 874   = [intPrimTy, byteArrayPrimTy, -- Integer\r
 875      intPrimTy]\r
 876 \r
 877 unboxedPair      = mkUnboxedTupleTy 2\r
 878 unboxedTriple    = mkUnboxedTupleTy 3\r
 879 unboxedQuadruple = mkUnboxedTupleTy 4\r
 880 \r
 881 integerMonadic name = mkGenPrimOp name [] one_Integer_ty \r
 882                         (unboxedPair one_Integer_ty)\r
 883 \r
 884 integerDyadic name = mkGenPrimOp name [] two_Integer_tys \r
 885                         (unboxedPair one_Integer_ty)\r
 886 \r
 887 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys \r
 888     (unboxedQuadruple two_Integer_tys)\r
 889 \r
 890 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy\r
 891 \end{code}\r
 892 \r
 893 %************************************************************************\r
 894 %*                                                                      *\r
 895 \subsubsection{Strictness}\r
 896 %*                                                                      *\r
 897 %************************************************************************\r
 898 \r
 899 Not all primops are strict!\r
 900 \r
 901 \begin{code}\r
 902 primOpStrictness :: PrimOp -> ([Demand], Bool)\r
 903         -- See IdInfo.StrictnessInfo for discussion of what the results\r
 904         -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,\r
 905         -- the list of demands may be infinite!\r
 906         -- Use only the ones you ned.\r
 907 \r
 908 primOpStrictness SeqOp            = ([wwStrict], False)\r
 909         -- Seq is strict in its argument; see notes in ConFold.lhs\r
 910 \r
 911 primOpStrictness ParOp            = ([wwLazy], False)\r
 912         -- But Par is lazy, to avoid that the sparked thing\r
 913         -- gets evaluted strictly, which it should *not* be\r
 914 \r
 915 primOpStrictness ForkOp           = ([wwLazy, wwPrim], False)\r
 916 \r
 917 primOpStrictness NewArrayOp       = ([wwPrim, wwLazy, wwPrim], False)\r
 918 primOpStrictness WriteArrayOp     = ([wwPrim, wwPrim, wwLazy, wwPrim], False)\r
 919 \r
 920 primOpStrictness NewMutVarOp      = ([wwLazy, wwPrim], False)\r
 921 primOpStrictness WriteMutVarOp    = ([wwPrim, wwLazy, wwPrim], False)\r
 922 \r
 923 primOpStrictness PutMVarOp        = ([wwPrim, wwLazy, wwPrim], False)\r
 924 \r
 925 primOpStrictness CatchOp          = ([wwLazy, wwLazy], False)\r
 926 primOpStrictness RaiseOp          = ([wwLazy], True)    -- NB: True => result is bottom\r
 927 \r
 928 primOpStrictness MkWeakOp         = ([wwLazy, wwLazy, wwLazy, wwPrim], False)\r
 929 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)\r
 930 primOpStrictness MakeStablePtrOp  = ([wwLazy, wwPrim], False)\r
 931 \r
 932 primOpStrictness DataToTagOp      = ([wwLazy], False)\r
 933 \r
 934         -- The rest all have primitive-typed arguments\r
 935 primOpStrictness other            = (repeat wwPrim, False)\r
 936 \end{code}\r
 937 \r
 938 %************************************************************************\r
 939 %*                                                                      *\r
 940 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}\r
 941 %*                                                                      *\r
 942 %************************************************************************\r
 943 \r
 944 @primOpInfo@ gives all essential information (from which everything\r
 945 else, notably a type, can be constructed) for each @PrimOp@.\r
 946 \r
 947 \begin{code}\r
 948 primOpInfo :: PrimOp -> PrimOpInfo\r
 949 \end{code}\r
 950 \r
 951 There's plenty of this stuff!\r
 952 \r
 953 \begin{code}\r
 954 primOpInfo CharGtOp   = mkCompare SLIT("gtChar#")   charPrimTy\r
 955 primOpInfo CharGeOp   = mkCompare SLIT("geChar#")   charPrimTy\r
 956 primOpInfo CharEqOp   = mkCompare SLIT("eqChar#")   charPrimTy\r
 957 primOpInfo CharNeOp   = mkCompare SLIT("neChar#")   charPrimTy\r
 958 primOpInfo CharLtOp   = mkCompare SLIT("ltChar#")   charPrimTy\r
 959 primOpInfo CharLeOp   = mkCompare SLIT("leChar#")   charPrimTy\r
 960 \r
 961 primOpInfo IntGtOp    = mkCompare SLIT(">#")       intPrimTy\r
 962 primOpInfo IntGeOp    = mkCompare SLIT(">=#")      intPrimTy\r
 963 primOpInfo IntEqOp    = mkCompare SLIT("==#")      intPrimTy\r
 964 primOpInfo IntNeOp    = mkCompare SLIT("/=#")      intPrimTy\r
 965 primOpInfo IntLtOp    = mkCompare SLIT("<#")       intPrimTy\r
 966 primOpInfo IntLeOp    = mkCompare SLIT("<=#")      intPrimTy\r
 967 \r
 968 primOpInfo WordGtOp   = mkCompare SLIT("gtWord#")   wordPrimTy\r
 969 primOpInfo WordGeOp   = mkCompare SLIT("geWord#")   wordPrimTy\r
 970 primOpInfo WordEqOp   = mkCompare SLIT("eqWord#")   wordPrimTy\r
 971 primOpInfo WordNeOp   = mkCompare SLIT("neWord#")   wordPrimTy\r
 972 primOpInfo WordLtOp   = mkCompare SLIT("ltWord#")   wordPrimTy\r
 973 primOpInfo WordLeOp   = mkCompare SLIT("leWord#")   wordPrimTy\r
 974 \r
 975 primOpInfo AddrGtOp   = mkCompare SLIT("gtAddr#")   addrPrimTy\r
 976 primOpInfo AddrGeOp   = mkCompare SLIT("geAddr#")   addrPrimTy\r
 977 primOpInfo AddrEqOp   = mkCompare SLIT("eqAddr#")   addrPrimTy\r
 978 primOpInfo AddrNeOp   = mkCompare SLIT("neAddr#")   addrPrimTy\r
 979 primOpInfo AddrLtOp   = mkCompare SLIT("ltAddr#")   addrPrimTy\r
 980 primOpInfo AddrLeOp   = mkCompare SLIT("leAddr#")   addrPrimTy\r
 981 \r
 982 primOpInfo FloatGtOp  = mkCompare SLIT("gtFloat#")  floatPrimTy\r
 983 primOpInfo FloatGeOp  = mkCompare SLIT("geFloat#")  floatPrimTy\r
 984 primOpInfo FloatEqOp  = mkCompare SLIT("eqFloat#")  floatPrimTy\r
 985 primOpInfo FloatNeOp  = mkCompare SLIT("neFloat#")  floatPrimTy\r
 986 primOpInfo FloatLtOp  = mkCompare SLIT("ltFloat#")  floatPrimTy\r
 987 primOpInfo FloatLeOp  = mkCompare SLIT("leFloat#")  floatPrimTy\r
 988 \r
 989 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy\r
 990 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy\r
 991 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy\r
 992 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy\r
 993 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy\r
 994 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy\r
 995 \r
 996 \end{code}\r
 997 \r
 998 %************************************************************************\r
 999 %*                                                                      *\r
1000 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}\r
1001 %*                                                                      *\r
1002 %************************************************************************\r
1003 \r
1004 \begin{code}\r
1005 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy\r
1006 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy]  charPrimTy\r
1007 \end{code}\r
1008 \r
1009 %************************************************************************\r
1010 %*                                                                      *\r
1011 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}\r
1012 %*                                                                      *\r
1013 %************************************************************************\r
1014 \r
1015 \begin{code}\r
1016 primOpInfo IntAddOp  = mkDyadic SLIT("+#")       intPrimTy\r
1017 primOpInfo IntSubOp  = mkDyadic SLIT("-#") intPrimTy\r
1018 primOpInfo IntMulOp  = mkDyadic SLIT("*#") intPrimTy\r
1019 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#")         intPrimTy\r
1020 primOpInfo IntRemOp  = mkDyadic SLIT("remInt#")  intPrimTy\r
1021 \r
1022 primOpInfo IntNegOp  = mkMonadic SLIT("negateInt#") intPrimTy\r
1023 primOpInfo IntAbsOp  = mkMonadic SLIT("absInt#") intPrimTy\r
1024 \r
1025 primOpInfo IntAddCOp = \r
1026         mkGenPrimOp SLIT("addIntC#")  [] [intPrimTy, intPrimTy] \r
1027                 (unboxedPair [intPrimTy, intPrimTy])\r
1028 \r
1029 primOpInfo IntSubCOp = \r
1030         mkGenPrimOp SLIT("subIntC#")  [] [intPrimTy, intPrimTy] \r
1031                 (unboxedPair [intPrimTy, intPrimTy])\r
1032 \r
1033 primOpInfo IntMulCOp = \r
1034         mkGenPrimOp SLIT("mulIntC#")  [] [intPrimTy, intPrimTy] \r
1035                 (unboxedPair [intPrimTy, intPrimTy])\r
1036 \end{code}\r
1037 \r
1038 %************************************************************************\r
1039 %*                                                                      *\r
1040 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}\r
1041 %*                                                                      *\r
1042 %************************************************************************\r
1043 \r
1044 A @Word#@ is an unsigned @Int#@.\r
1045 \r
1046 \begin{code}\r
1047 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy\r
1048 primOpInfo WordRemOp  = mkDyadic SLIT("remWord#")        wordPrimTy\r
1049 \r
1050 primOpInfo AndOp    = mkDyadic  SLIT("and#")    wordPrimTy\r
1051 primOpInfo OrOp     = mkDyadic  SLIT("or#")     wordPrimTy\r
1052 primOpInfo XorOp    = mkDyadic  SLIT("xor#")    wordPrimTy\r
1053 primOpInfo NotOp    = mkMonadic SLIT("not#")    wordPrimTy\r
1054 \r
1055 primOpInfo SllOp\r
1056   = mkGenPrimOp SLIT("shiftL#")  [] [wordPrimTy, intPrimTy] wordPrimTy\r
1057 primOpInfo SrlOp\r
1058   = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy\r
1059 \r
1060 primOpInfo ISllOp\r
1061   = mkGenPrimOp SLIT("iShiftL#")  [] [intPrimTy, intPrimTy] intPrimTy\r
1062 primOpInfo ISraOp\r
1063   = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy\r
1064 primOpInfo ISrlOp\r
1065   = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy\r
1066 \r
1067 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy\r
1068 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy\r
1069 \end{code}\r
1070 \r
1071 %************************************************************************\r
1072 %*                                                                      *\r
1073 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}\r
1074 %*                                                                      *\r
1075 %************************************************************************\r
1076 \r
1077 \begin{code}\r
1078 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy\r
1079 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy\r
1080 \end{code}\r
1081 \r
1082 \r
1083 %************************************************************************\r
1084 %*                                                                      *\r
1085 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}\r
1086 %*                                                                      *\r
1087 %************************************************************************\r
1088 \r
1089 @decodeFloat#@ is given w/ Integer-stuff (it's similar).\r
1090 \r
1091 \begin{code}\r
1092 primOpInfo FloatAddOp   = mkDyadic    SLIT("plusFloat#")           floatPrimTy\r
1093 primOpInfo FloatSubOp   = mkDyadic    SLIT("minusFloat#")   floatPrimTy\r
1094 primOpInfo FloatMulOp   = mkDyadic    SLIT("timesFloat#")   floatPrimTy\r
1095 primOpInfo FloatDivOp   = mkDyadic    SLIT("divideFloat#")  floatPrimTy\r
1096 primOpInfo FloatNegOp   = mkMonadic   SLIT("negateFloat#")  floatPrimTy\r
1097 \r
1098 primOpInfo Float2IntOp  = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy\r
1099 primOpInfo Int2FloatOp  = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy\r
1100 \r
1101 primOpInfo FloatExpOp   = mkMonadic   SLIT("expFloat#")    floatPrimTy\r
1102 primOpInfo FloatLogOp   = mkMonadic   SLIT("logFloat#")    floatPrimTy\r
1103 primOpInfo FloatSqrtOp  = mkMonadic   SLIT("sqrtFloat#")           floatPrimTy\r
1104 primOpInfo FloatSinOp   = mkMonadic   SLIT("sinFloat#")    floatPrimTy\r
1105 primOpInfo FloatCosOp   = mkMonadic   SLIT("cosFloat#")    floatPrimTy\r
1106 primOpInfo FloatTanOp   = mkMonadic   SLIT("tanFloat#")    floatPrimTy\r
1107 primOpInfo FloatAsinOp  = mkMonadic   SLIT("asinFloat#")           floatPrimTy\r
1108 primOpInfo FloatAcosOp  = mkMonadic   SLIT("acosFloat#")           floatPrimTy\r
1109 primOpInfo FloatAtanOp  = mkMonadic   SLIT("atanFloat#")           floatPrimTy\r
1110 primOpInfo FloatSinhOp  = mkMonadic   SLIT("sinhFloat#")           floatPrimTy\r
1111 primOpInfo FloatCoshOp  = mkMonadic   SLIT("coshFloat#")           floatPrimTy\r
1112 primOpInfo FloatTanhOp  = mkMonadic   SLIT("tanhFloat#")           floatPrimTy\r
1113 primOpInfo FloatPowerOp = mkDyadic    SLIT("powerFloat#")   floatPrimTy\r
1114 \end{code}\r
1115 \r
1116 %************************************************************************\r
1117 %*                                                                      *\r
1118 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}\r
1119 %*                                                                      *\r
1120 %************************************************************************\r
1121 \r
1122 @decodeDouble#@ is given w/ Integer-stuff (it's similar).\r
1123 \r
1124 \begin{code}\r
1125 primOpInfo DoubleAddOp  = mkDyadic    SLIT("+##")   doublePrimTy\r
1126 primOpInfo DoubleSubOp  = mkDyadic    SLIT("-##")  doublePrimTy\r
1127 primOpInfo DoubleMulOp  = mkDyadic    SLIT("*##")  doublePrimTy\r
1128 primOpInfo DoubleDivOp  = mkDyadic    SLIT("/##") doublePrimTy\r
1129 primOpInfo DoubleNegOp  = mkMonadic   SLIT("negateDouble#") doublePrimTy\r
1130 \r
1131 primOpInfo Double2IntOp     = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy\r
1132 primOpInfo Int2DoubleOp     = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy\r
1133 \r
1134 primOpInfo Double2FloatOp   = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy\r
1135 primOpInfo Float2DoubleOp   = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy\r
1136 \r
1137 primOpInfo DoubleExpOp  = mkMonadic   SLIT("expDouble#")           doublePrimTy\r
1138 primOpInfo DoubleLogOp  = mkMonadic   SLIT("logDouble#")           doublePrimTy\r
1139 primOpInfo DoubleSqrtOp = mkMonadic   SLIT("sqrtDouble#")   doublePrimTy\r
1140 primOpInfo DoubleSinOp  = mkMonadic   SLIT("sinDouble#")           doublePrimTy\r
1141 primOpInfo DoubleCosOp  = mkMonadic   SLIT("cosDouble#")           doublePrimTy\r
1142 primOpInfo DoubleTanOp  = mkMonadic   SLIT("tanDouble#")           doublePrimTy\r
1143 primOpInfo DoubleAsinOp = mkMonadic   SLIT("asinDouble#")   doublePrimTy\r
1144 primOpInfo DoubleAcosOp = mkMonadic   SLIT("acosDouble#")   doublePrimTy\r
1145 primOpInfo DoubleAtanOp = mkMonadic   SLIT("atanDouble#")   doublePrimTy\r
1146 primOpInfo DoubleSinhOp = mkMonadic   SLIT("sinhDouble#")   doublePrimTy\r
1147 primOpInfo DoubleCoshOp = mkMonadic   SLIT("coshDouble#")   doublePrimTy\r
1148 primOpInfo DoubleTanhOp = mkMonadic   SLIT("tanhDouble#")   doublePrimTy\r
1149 primOpInfo DoublePowerOp= mkDyadic    SLIT("**##")  doublePrimTy\r
1150 \end{code}\r
1151 \r
1152 %************************************************************************\r
1153 %*                                                                      *\r
1154 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}\r
1155 %*                                                                      *\r
1156 %************************************************************************\r
1157 \r
1158 \begin{code}\r
1159 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")\r
1160 \r
1161 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")\r
1162 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")\r
1163 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")\r
1164 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")\r
1165 \r
1166 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")\r
1167 primOpInfo IntegerCmpIntOp \r
1168   = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy\r
1169 \r
1170 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")\r
1171 primOpInfo IntegerDivModOp  = integerDyadic2Results SLIT("divModInteger#")\r
1172 \r
1173 primOpInfo Integer2IntOp\r
1174   = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy\r
1175 \r
1176 primOpInfo Integer2WordOp\r
1177   = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy\r
1178 \r
1179 primOpInfo Int2IntegerOp\r
1180   = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy] \r
1181         (unboxedPair one_Integer_ty)\r
1182 \r
1183 primOpInfo Word2IntegerOp\r
1184   = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy] \r
1185         (unboxedPair one_Integer_ty)\r
1186 \r
1187 primOpInfo Addr2IntegerOp\r
1188   = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy] \r
1189         (unboxedPair one_Integer_ty)\r
1190 \r
1191 primOpInfo IntegerToInt64Op\r
1192   = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy\r
1193 \r
1194 primOpInfo Int64ToIntegerOp\r
1195   = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]\r
1196         (unboxedPair one_Integer_ty)\r
1197 \r
1198 primOpInfo Word64ToIntegerOp\r
1199   = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy] \r
1200         (unboxedPair one_Integer_ty)\r
1201 \r
1202 primOpInfo IntegerToWord64Op\r
1203   = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy\r
1204 \end{code}\r
1205 \r
1206 Decoding of floating-point numbers is sorta Integer-related.  Encoding\r
1207 is done with plain ccalls now (see PrelNumExtra.lhs).\r
1208 \r
1209 \begin{code}\r
1210 primOpInfo FloatDecodeOp\r
1211   = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy] \r
1212         (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])\r
1213 primOpInfo DoubleDecodeOp\r
1214   = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy] \r
1215         (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])\r
1216 \end{code}\r
1217 \r
1218 %************************************************************************\r
1219 %*                                                                      *\r
1220 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}\r
1221 %*                                                                      *\r
1222 %************************************************************************\r
1223 \r
1224 \begin{verbatim}\r
1225 newArray#    :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)\r
1226 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)\r
1227 \end{verbatim}\r
1228 \r
1229 \begin{code}\r
1230 primOpInfo NewArrayOp\r
1231   = let {\r
1232         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1233         state = mkStatePrimTy s\r
1234     } in\r
1235     mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv] \r
1236         [intPrimTy, elt, state]\r
1237         (unboxedPair [state, mkMutableArrayPrimTy s elt])\r
1238 \r
1239 primOpInfo (NewByteArrayOp kind)\r
1240   = let\r
1241         s = alphaTy; s_tv = alphaTyVar\r
1242 \r
1243         op_str         = _PK_ ("new" ++ primRepString kind ++ "Array#")\r
1244         state = mkStatePrimTy s\r
1245     in\r
1246     mkGenPrimOp op_str [s_tv]\r
1247         [intPrimTy, state]\r
1248         (unboxedPair [state, mkMutableByteArrayPrimTy s])\r
1249 \r
1250 ---------------------------------------------------------------------------\r
1251 \r
1252 {-\r
1253 sameMutableArray#     :: MutArr# s a -> MutArr# s a -> Bool\r
1254 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool\r
1255 -}\r
1256 \r
1257 primOpInfo SameMutableArrayOp\r
1258   = let {\r
1259         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1260         mut_arr_ty = mkMutableArrayPrimTy s elt\r
1261     } in\r
1262     mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]\r
1263                                    boolTy\r
1264 \r
1265 primOpInfo SameMutableByteArrayOp\r
1266   = let {\r
1267         s = alphaTy; s_tv = alphaTyVar;\r
1268         mut_arr_ty = mkMutableByteArrayPrimTy s\r
1269     } in\r
1270     mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]\r
1271                                    boolTy\r
1272 \r
1273 ---------------------------------------------------------------------------\r
1274 -- Primitive arrays of Haskell pointers:\r
1275 \r
1276 {-\r
1277 readArray#  :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)\r
1278 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s\r
1279 indexArray# :: Array# a -> Int# -> (# a #)\r
1280 -}\r
1281 \r
1282 primOpInfo ReadArrayOp\r
1283   = let {\r
1284         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1285         state = mkStatePrimTy s\r
1286     } in\r
1287     mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]\r
1288         [mkMutableArrayPrimTy s elt, intPrimTy, state]\r
1289         (unboxedPair [state, elt])\r
1290 \r
1291 \r
1292 primOpInfo WriteArrayOp\r
1293   = let {\r
1294         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1295     } in\r
1296     mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]\r
1297         [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]\r
1298         (mkStatePrimTy s)\r
1299 \r
1300 primOpInfo IndexArrayOp\r
1301   = let { elt = alphaTy; elt_tv = alphaTyVar } in\r
1302     mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]\r
1303         (mkUnboxedTupleTy 1 [elt])\r
1304 \r
1305 ---------------------------------------------------------------------------\r
1306 -- Primitive arrays full of unboxed bytes:\r
1307 \r
1308 primOpInfo (ReadByteArrayOp kind)\r
1309   = let\r
1310         s = alphaTy; s_tv = alphaTyVar\r
1311 \r
1312         op_str         = _PK_ ("read" ++ primRepString kind ++ "Array#")\r
1313         (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
1314         state          = mkStatePrimTy s\r
1315     in\r
1316     mkGenPrimOp op_str (s_tv:tvs)\r
1317         [mkMutableByteArrayPrimTy s, intPrimTy, state]\r
1318         (unboxedPair [state, prim_ty])\r
1319 \r
1320 primOpInfo (WriteByteArrayOp kind)\r
1321   = let\r
1322         s = alphaTy; s_tv = alphaTyVar\r
1323         op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")\r
1324         (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
1325     in\r
1326     mkGenPrimOp op_str (s_tv:tvs)\r
1327         [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]\r
1328         (mkStatePrimTy s)\r
1329 \r
1330 primOpInfo (IndexByteArrayOp kind)\r
1331   = let\r
1332         op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")\r
1333         (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
1334     in\r
1335     mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty\r
1336 \r
1337 primOpInfo (IndexOffForeignObjOp kind)\r
1338   = let\r
1339         op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")\r
1340         (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
1341     in\r
1342     mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty\r
1343 \r
1344 primOpInfo (IndexOffAddrOp kind)\r
1345   = let\r
1346         op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")\r
1347         (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind\r
1348     in\r
1349     mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty\r
1350 \r
1351 primOpInfo (WriteOffAddrOp kind)\r
1352   = let\r
1353         s = alphaTy; s_tv = alphaTyVar\r
1354         op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")\r
1355         (tvs, prim_ty) = mkPrimTyApp betaTyVars kind\r
1356     in\r
1357     mkGenPrimOp op_str (s_tv:tvs)\r
1358         [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]\r
1359         (mkStatePrimTy s)\r
1360 \r
1361 ---------------------------------------------------------------------------\r
1362 {-\r
1363 unsafeFreezeArray#     :: MutArr# s a -> State# s -> (# State# s, Array# a #)\r
1364 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)\r
1365 unsafeThawArray#       :: Array# a -> State# s -> (# State# s, MutArr# s a #)\r
1366 unsafeThawByteArray#   :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)\r
1367 -}\r
1368 \r
1369 primOpInfo UnsafeFreezeArrayOp\r
1370   = let {\r
1371         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1372         state = mkStatePrimTy s\r
1373     } in\r
1374     mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]\r
1375         [mkMutableArrayPrimTy s elt, state]\r
1376         (unboxedPair [state, mkArrayPrimTy elt])\r
1377 \r
1378 primOpInfo UnsafeFreezeByteArrayOp\r
1379   = let { \r
1380         s = alphaTy; s_tv = alphaTyVar;\r
1381         state = mkStatePrimTy s\r
1382     } in\r
1383     mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]\r
1384         [mkMutableByteArrayPrimTy s, state]\r
1385         (unboxedPair [state, byteArrayPrimTy])\r
1386 \r
1387 primOpInfo UnsafeThawArrayOp\r
1388   = let {\r
1389         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1390         state = mkStatePrimTy s\r
1391     } in\r
1392     mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]\r
1393         [mkArrayPrimTy elt, state]\r
1394         (unboxedPair [state, mkMutableArrayPrimTy s elt])\r
1395 \r
1396 primOpInfo UnsafeThawByteArrayOp\r
1397   = let { \r
1398         s = alphaTy; s_tv = alphaTyVar;\r
1399         state = mkStatePrimTy s\r
1400     } in\r
1401     mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]\r
1402         [byteArrayPrimTy, state]\r
1403         (unboxedPair [state, mkMutableByteArrayPrimTy s])\r
1404 \r
1405 ---------------------------------------------------------------------------\r
1406 primOpInfo SizeofByteArrayOp\r
1407   = mkGenPrimOp\r
1408         SLIT("sizeofByteArray#") []\r
1409         [byteArrayPrimTy]\r
1410         intPrimTy\r
1411 \r
1412 primOpInfo SizeofMutableByteArrayOp\r
1413   = let { s = alphaTy; s_tv = alphaTyVar } in\r
1414     mkGenPrimOp\r
1415         SLIT("sizeofMutableByteArray#") [s_tv]\r
1416         [mkMutableByteArrayPrimTy s]\r
1417         intPrimTy\r
1418 \end{code}\r
1419 \r
1420 \r
1421 %************************************************************************\r
1422 %*                                                                      *\r
1423 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}\r
1424 %*                                                                      *\r
1425 %************************************************************************\r
1426 \r
1427 \begin{code}\r
1428 primOpInfo NewMutVarOp\r
1429   = let {\r
1430         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1431         state = mkStatePrimTy s\r
1432     } in\r
1433     mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv] \r
1434         [elt, state]\r
1435         (unboxedPair [state, mkMutVarPrimTy s elt])\r
1436 \r
1437 primOpInfo ReadMutVarOp\r
1438   = let {\r
1439         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1440         state = mkStatePrimTy s\r
1441     } in\r
1442     mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]\r
1443         [mkMutVarPrimTy s elt, state]\r
1444         (unboxedPair [state, elt])\r
1445 \r
1446 \r
1447 primOpInfo WriteMutVarOp\r
1448   = let {\r
1449         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1450     } in\r
1451     mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]\r
1452         [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]\r
1453         (mkStatePrimTy s)\r
1454 \r
1455 primOpInfo SameMutVarOp\r
1456   = let {\r
1457         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;\r
1458         mut_var_ty = mkMutVarPrimTy s elt\r
1459     } in\r
1460     mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]\r
1461                                    boolTy\r
1462 \end{code}\r
1463 \r
1464 %************************************************************************\r
1465 %*                                                                      *\r
1466 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}\r
1467 %*                                                                      *\r
1468 %************************************************************************\r
1469 \r
1470 catch  :: IO a -> (IOError -> IO a) -> IO a\r
1471 catch# :: a  -> (b -> a) -> a\r
1472 \r
1473 \begin{code}\r
1474 primOpInfo CatchOp   \r
1475   = let\r
1476         a = alphaTy; a_tv = alphaTyVar\r
1477         b = betaTy;  b_tv = betaTyVar;\r
1478     in\r
1479     mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a\r
1480 \r
1481 primOpInfo RaiseOp\r
1482   = let\r
1483         a = alphaTy; a_tv = alphaTyVar\r
1484         b = betaTy;  b_tv = betaTyVar;\r
1485     in\r
1486     mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b\r
1487 \end{code}\r
1488 \r
1489 %************************************************************************\r
1490 %*                                                                      *\r
1491 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}\r
1492 %*                                                                      *\r
1493 %************************************************************************\r
1494 \r
1495 \begin{code}\r
1496 primOpInfo NewMVarOp\r
1497   = let\r
1498         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1499         state = mkStatePrimTy s\r
1500     in\r
1501     mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]\r
1502         (unboxedPair [state, mkMVarPrimTy s elt])\r
1503 \r
1504 primOpInfo TakeMVarOp\r
1505   = let\r
1506         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1507         state = mkStatePrimTy s\r
1508     in\r
1509     mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]\r
1510         [mkMVarPrimTy s elt, state]\r
1511         (unboxedPair [state, elt])\r
1512 \r
1513 primOpInfo PutMVarOp\r
1514   = let\r
1515         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1516     in\r
1517     mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]\r
1518         [mkMVarPrimTy s elt, elt, mkStatePrimTy s]\r
1519         (mkStatePrimTy s)\r
1520 \r
1521 primOpInfo SameMVarOp\r
1522   = let\r
1523         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1524         mvar_ty = mkMVarPrimTy s elt\r
1525     in\r
1526     mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy\r
1527 \r
1528 primOpInfo IsEmptyMVarOp\r
1529   = let\r
1530         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar\r
1531         state = mkStatePrimTy s\r
1532     in\r
1533     mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]\r
1534         [mkMVarPrimTy s elt, mkStatePrimTy s]\r
1535         (unboxedPair [state, intPrimTy])\r
1536 \r
1537 \end{code}\r
1538 \r
1539 %************************************************************************\r
1540 %*                                                                      *\r
1541 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}\r
1542 %*                                                                      *\r
1543 %************************************************************************\r
1544 \r
1545 \begin{code}\r
1546 \r
1547 primOpInfo DelayOp\r
1548   = let {\r
1549         s = alphaTy; s_tv = alphaTyVar\r
1550     } in\r
1551     mkGenPrimOp SLIT("delay#") [s_tv]\r
1552         [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
1553 \r
1554 primOpInfo WaitReadOp\r
1555   = let {\r
1556         s = alphaTy; s_tv = alphaTyVar\r
1557     } in\r
1558     mkGenPrimOp SLIT("waitRead#") [s_tv]\r
1559         [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
1560 \r
1561 primOpInfo WaitWriteOp\r
1562   = let {\r
1563         s = alphaTy; s_tv = alphaTyVar\r
1564     } in\r
1565     mkGenPrimOp SLIT("waitWrite#") [s_tv]\r
1566         [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
1567 \end{code}\r
1568 \r
1569 %************************************************************************\r
1570 %*                                                                      *\r
1571 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}\r
1572 %*                                                                      *\r
1573 %************************************************************************\r
1574 \r
1575 \begin{code}\r
1576 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)\r
1577 primOpInfo ForkOp       \r
1578   = mkGenPrimOp SLIT("fork#") [alphaTyVar] \r
1579         [alphaTy, realWorldStatePrimTy]\r
1580         (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])\r
1581 \r
1582 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld\r
1583 primOpInfo KillThreadOp\r
1584   = mkGenPrimOp SLIT("killThread#") [alphaTyVar] \r
1585         [threadIdPrimTy, alphaTy, realWorldStatePrimTy]\r
1586         realWorldStatePrimTy\r
1587 \r
1588 -- yield# :: State# RealWorld -> State# RealWorld\r
1589 primOpInfo YieldOp\r
1590   = mkGenPrimOp SLIT("yield#") [] \r
1591         [realWorldStatePrimTy]\r
1592         realWorldStatePrimTy\r
1593 \r
1594 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)\r
1595 primOpInfo MyThreadIdOp\r
1596   = mkGenPrimOp SLIT("myThreadId#") [] \r
1597         [realWorldStatePrimTy]\r
1598         (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])\r
1599 \end{code}\r
1600 \r
1601 ************************************************************************\r
1602 %*                                                                      *\r
1603 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}\r
1604 %*                                                                      *\r
1605 %************************************************************************\r
1606 \r
1607 \begin{code}\r
1608 primOpInfo MakeForeignObjOp\r
1609   = mkGenPrimOp SLIT("makeForeignObj#") [] \r
1610         [addrPrimTy, realWorldStatePrimTy] \r
1611         (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])\r
1612 \r
1613 primOpInfo WriteForeignObjOp\r
1614  = let {\r
1615         s = alphaTy; s_tv = alphaTyVar\r
1616     } in\r
1617    mkGenPrimOp SLIT("writeForeignObj#") [s_tv]\r
1618         [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)\r
1619 \end{code}\r
1620 \r
1621 ************************************************************************\r
1622 %*                                                                      *\r
1623 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}\r
1624 %*                                                                      *\r
1625 %************************************************************************\r
1626 \r
1627 A @Weak@ Pointer is created by the @mkWeak#@ primitive:\r
1628 \r
1629         mkWeak# :: k -> v -> f -> State# RealWorld \r
1630                         -> (# State# RealWorld, Weak# v #)\r
1631 \r
1632 In practice, you'll use the higher-level\r
1633 \r
1634         data Weak v = Weak# v\r
1635         mkWeak :: k -> v -> IO () -> IO (Weak v)\r
1636 \r
1637 \begin{code}\r
1638 primOpInfo MkWeakOp\r
1639   = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar] \r
1640         [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]\r
1641         (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])\r
1642 \end{code}\r
1643 \r
1644 The following operation dereferences a weak pointer.  The weak pointer\r
1645 may have been finalized, so the operation returns a result code which\r
1646 must be inspected before looking at the dereferenced value.\r
1647 \r
1648         deRefWeak# :: Weak# v -> State# RealWorld ->\r
1649                         (# State# RealWorld, v, Int# #)\r
1650 \r
1651 Only look at v if the Int# returned is /= 0 !!\r
1652 \r
1653 The higher-level op is\r
1654 \r
1655         deRefWeak :: Weak v -> IO (Maybe v)\r
1656 \r
1657 \begin{code}\r
1658 primOpInfo DeRefWeakOp\r
1659  = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]\r
1660         [mkWeakPrimTy alphaTy, realWorldStatePrimTy]\r
1661         (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])\r
1662 \end{code}\r
1663 \r
1664 Weak pointers can be finalized early by using the finalize# operation:\r
1665         \r
1666         finalizeWeak# :: Weak# v -> State# RealWorld -> \r
1667                            (# State# RealWorld, Int#, IO () #)\r
1668 \r
1669 The Int# returned is either\r
1670 \r
1671         0 if the weak pointer has already been finalized, or it has no\r
1672           finalizer (the third component is then invalid).\r
1673 \r
1674         1 if the weak pointer is still alive, with the finalizer returned\r
1675           as the third component.\r
1676 \r
1677 \begin{code}\r
1678 primOpInfo FinalizeWeakOp\r
1679  = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]\r
1680         [mkWeakPrimTy alphaTy, realWorldStatePrimTy]\r
1681         (unboxedTriple [realWorldStatePrimTy, intPrimTy,\r
1682                         mkFunTy realWorldStatePrimTy \r
1683                           (unboxedPair [realWorldStatePrimTy,unitTy])])\r
1684 \end{code}\r
1685 \r
1686 %************************************************************************\r
1687 %*                                                                      *\r
1688 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}\r
1689 %*                                                                      *\r
1690 %************************************************************************\r
1691 \r
1692 A {\em stable name/pointer} is an index into a table of stable name\r
1693 entries.  Since the garbage collector is told about stable pointers,\r
1694 it is safe to pass a stable pointer to external systems such as C\r
1695 routines.\r
1696 \r
1697 \begin{verbatim}\r
1698 makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)\r
1699 freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld\r
1700 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)\r
1701 eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#\r
1702 \end{verbatim}\r
1703 \r
1704 It may seem a bit surprising that @makeStablePtr#@ is a @IO@\r
1705 operation since it doesn't (directly) involve IO operations.  The\r
1706 reason is that if some optimisation pass decided to duplicate calls to\r
1707 @makeStablePtr#@ and we only pass one of the stable pointers over, a\r
1708 massive space leak can result.  Putting it into the IO monad\r
1709 prevents this.  (Another reason for putting them in a monad is to\r
1710 ensure correct sequencing wrt the side-effecting @freeStablePtr@\r
1711 operation.)\r
1712 \r
1713 An important property of stable pointers is that if you call\r
1714 makeStablePtr# twice on the same object you get the same stable\r
1715 pointer back.\r
1716 \r
1717 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,\r
1718 besides, it's not likely to be used from Haskell) so it's not a\r
1719 primop.\r
1720 \r
1721 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]\r
1722 \r
1723 Stable Names\r
1724 ~~~~~~~~~~~~\r
1725 \r
1726 A stable name is like a stable pointer, but with three important differences:\r
1727 \r
1728         (a) You can't deRef one to get back to the original object.\r
1729         (b) You can convert one to an Int.\r
1730         (c) You don't need to 'freeStableName'\r
1731 \r
1732 The existence of a stable name doesn't guarantee to keep the object it\r
1733 points to alive (unlike a stable pointer), hence (a).\r
1734 \r
1735 Invariants:\r
1736         \r
1737         (a) makeStableName always returns the same value for a given\r
1738             object (same as stable pointers).\r
1739 \r
1740         (b) if two stable names are equal, it implies that the objects\r
1741             from which they were created were the same.\r
1742 \r
1743         (c) stableNameToInt always returns the same Int for a given\r
1744             stable name.\r
1745 \r
1746 \begin{code}\r
1747 primOpInfo MakeStablePtrOp\r
1748   = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]\r
1749         [alphaTy, realWorldStatePrimTy]\r
1750         (unboxedPair [realWorldStatePrimTy, \r
1751                         mkTyConApp stablePtrPrimTyCon [alphaTy]])\r
1752 \r
1753 primOpInfo DeRefStablePtrOp\r
1754   = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]\r
1755         [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]\r
1756         (unboxedPair [realWorldStatePrimTy, alphaTy])\r
1757 \r
1758 primOpInfo EqStablePtrOp\r
1759   = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]\r
1760         [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]\r
1761         intPrimTy\r
1762 \r
1763 primOpInfo MakeStableNameOp\r
1764   = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]\r
1765         [alphaTy, realWorldStatePrimTy]\r
1766         (unboxedPair [realWorldStatePrimTy, \r
1767                         mkTyConApp stableNamePrimTyCon [alphaTy]])\r
1768 \r
1769 primOpInfo EqStableNameOp\r
1770   = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]\r
1771         [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]\r
1772         intPrimTy\r
1773 \r
1774 primOpInfo StableNameToIntOp\r
1775   = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]\r
1776         [mkStableNamePrimTy alphaTy]\r
1777         intPrimTy\r
1778 \end{code}\r
1779 \r
1780 %************************************************************************\r
1781 %*                                                                      *\r
1782 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}\r
1783 %*                                                                      *\r
1784 %************************************************************************\r
1785 \r
1786 [Alastair Reid is to blame for this!]\r
1787 \r
1788 These days, (Glasgow) Haskell seems to have a bit of everything from\r
1789 other languages: strict operations, mutable variables, sequencing,\r
1790 pointers, etc.  About the only thing left is LISP's ability to test\r
1791 for pointer equality.  So, let's add it in!\r
1792 \r
1793 \begin{verbatim}\r
1794 reallyUnsafePtrEquality :: a -> a -> Int#\r
1795 \end{verbatim}\r
1796 \r
1797 which tests any two closures (of the same type) to see if they're the\r
1798 same.  (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid\r
1799 difficulties of trying to box up the result.)\r
1800 \r
1801 NB This is {\em really unsafe\/} because even something as trivial as\r
1802 a garbage collection might change the answer by removing indirections.\r
1803 Still, no-one's forcing you to use it.  If you're worried about little\r
1804 things like loss of referential transparency, you might like to wrap\r
1805 it all up in a monad-like thing as John O'Donnell and John Hughes did\r
1806 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop\r
1807 Proceedings?)\r
1808 \r
1809 I'm thinking of using it to speed up a critical equality test in some\r
1810 graphics stuff in a context where the possibility of saying that\r
1811 denotationally equal things aren't isn't a problem (as long as it\r
1812 doesn't happen too often.)  ADR\r
1813 \r
1814 To Will: Jim said this was already in, but I can't see it so I'm\r
1815 adding it.  Up to you whether you add it.  (Note that this could have\r
1816 been readily implemented using a @veryDangerousCCall@ before they were\r
1817 removed...)\r
1818 \r
1819 \begin{code}\r
1820 primOpInfo ReallyUnsafePtrEqualityOp\r
1821   = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]\r
1822         [alphaTy, alphaTy] intPrimTy\r
1823 \end{code}\r
1824 \r
1825 %************************************************************************\r
1826 %*                                                                      *\r
1827 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}\r
1828 %*                                                                      *\r
1829 %************************************************************************\r
1830 \r
1831 \begin{code}\r
1832 primOpInfo SeqOp        -- seq# :: a -> Int#\r
1833   = mkGenPrimOp SLIT("seq#")    [alphaTyVar] [alphaTy] intPrimTy\r
1834 \r
1835 primOpInfo ParOp        -- par# :: a -> Int#\r
1836   = mkGenPrimOp SLIT("par#")    [alphaTyVar] [alphaTy] intPrimTy\r
1837 \end{code}\r
1838 \r
1839 \begin{code}\r
1840 -- HWL: The first 4 Int# in all par... annotations denote:\r
1841 --   name, granularity info, size of result, degree of parallelism\r
1842 --      Same  structure as _seq_ i.e. returns Int#\r
1843 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine\r
1844 --   `the processor containing the expression v'; it is not evaluated\r
1845 \r
1846 primOpInfo ParGlobalOp  -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1847   = mkGenPrimOp SLIT("parGlobal#")      [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
1848 \r
1849 primOpInfo ParLocalOp   -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1850   = mkGenPrimOp SLIT("parLocal#")       [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
1851 \r
1852 primOpInfo ParAtOp      -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1853   = mkGenPrimOp SLIT("parAt#")  [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy\r
1854 \r
1855 primOpInfo ParAtAbsOp   -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1856   = mkGenPrimOp SLIT("parAtAbs#")       [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
1857 \r
1858 primOpInfo ParAtRelOp   -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1859   = mkGenPrimOp SLIT("parAtRel#")       [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy\r
1860 \r
1861 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#\r
1862   = mkGenPrimOp SLIT("parAtForNow#")    [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy\r
1863 \r
1864 primOpInfo CopyableOp   -- copyable# :: a -> Int#\r
1865   = mkGenPrimOp SLIT("copyable#")       [alphaTyVar] [alphaTy] intPrimTy\r
1866 \r
1867 primOpInfo NoFollowOp   -- noFollow# :: a -> Int#\r
1868   = mkGenPrimOp SLIT("noFollow#")       [alphaTyVar] [alphaTy] intPrimTy\r
1869 \end{code}\r
1870 \r
1871 %************************************************************************\r
1872 %*                                                                      *\r
1873 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}\r
1874 %*                                                                      *\r
1875 %************************************************************************\r
1876 \r
1877 \begin{code}\r
1878 primOpInfo (CCallOp _ _ _ _)\r
1879      = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy\r
1880 \r
1881 {-\r
1882 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)\r
1883   = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied\r
1884   where\r
1885     (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty\r
1886 -}\r
1887 \end{code}\r
1888 \r
1889 %************************************************************************\r
1890 %*                                                                      *\r
1891 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}\r
1892 %*                                                                      *\r
1893 %************************************************************************\r
1894 \r
1895 These primops are pretty wierd.\r
1896 \r
1897         dataToTag# :: a -> Int    (arg must be an evaluated data type)\r
1898         tagToEnum# :: Int -> a    (result type must be an enumerated type)\r
1899 \r
1900 The constraints aren't currently checked by the front end, but the\r
1901 code generator will fall over if they aren't satisfied.\r
1902 \r
1903 \begin{code}\r
1904 primOpInfo DataToTagOp\r
1905   = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy\r
1906 \r
1907 primOpInfo TagToEnumOp\r
1908   = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy\r
1909 \r
1910 #ifdef DEBUG\r
1911 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))\r
1912 #endif\r
1913 \end{code}\r
1914 \r
1915 %************************************************************************\r
1916 %*                                                                      *\r
1917 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}\r
1918 %*                                                                      *\r
1919 %************************************************************************\r
1920 \r
1921 Some PrimOps need to be called out-of-line because they either need to\r
1922 perform a heap check or they block.\r
1923 \r
1924 \begin{code}\r
1925 primOpOutOfLine op\r
1926   = case op of\r
1927         TakeMVarOp              -> True\r
1928         PutMVarOp               -> True\r
1929         DelayOp                 -> True\r
1930         WaitReadOp              -> True\r
1931         WaitWriteOp             -> True\r
1932         CatchOp                 -> True\r
1933         RaiseOp                 -> True\r
1934         NewArrayOp              -> True\r
1935         NewByteArrayOp _        -> True\r
1936         IntegerAddOp            -> True\r
1937         IntegerSubOp            -> True\r
1938         IntegerMulOp            -> True\r
1939         IntegerGcdOp            -> True\r
1940         IntegerQuotRemOp        -> True\r
1941         IntegerDivModOp         -> True\r
1942         Int2IntegerOp           -> True\r
1943         Word2IntegerOp          -> True\r
1944         Addr2IntegerOp          -> True\r
1945         Word64ToIntegerOp       -> True\r
1946         Int64ToIntegerOp        -> True\r
1947         FloatDecodeOp           -> True\r
1948         DoubleDecodeOp          -> True\r
1949         MkWeakOp                -> True\r
1950         FinalizeWeakOp          -> True\r
1951         MakeStableNameOp        -> True\r
1952         MakeForeignObjOp        -> True\r
1953         NewMutVarOp             -> True\r
1954         NewMVarOp               -> True\r
1955         ForkOp                  -> True\r
1956         KillThreadOp            -> True\r
1957         YieldOp                 -> True\r
1958         CCallOp _ _ may_gc@True _ -> True       -- _ccall_GC_\r
1959           -- the next one doesn't perform any heap checks,\r
1960           -- but it is of such an esoteric nature that\r
1961           -- it is done out-of-line rather than require\r
1962           -- the NCG to implement it.\r
1963         UnsafeThawArrayOp       -> True\r
1964         _                       -> False\r
1965 \end{code}\r
1966 \r
1967 Sometimes we may choose to execute a PrimOp even though it isn't\r
1968 certain that its result will be required; ie execute them\r
1969 ``speculatively''.  The same thing as ``cheap eagerness.'' Usually\r
1970 this is OK, because PrimOps are usually cheap, but it isn't OK for\r
1971 (a)~expensive PrimOps and (b)~PrimOps which can fail.\r
1972 \r
1973 See also @primOpIsCheap@ (below).\r
1974 \r
1975 PrimOps that have side effects also should not be executed speculatively\r
1976 or by data dependencies.\r
1977 \r
1978 \begin{code}\r
1979 primOpOkForSpeculation :: PrimOp -> Bool\r
1980 primOpOkForSpeculation op \r
1981   = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)\r
1982 \end{code}\r
1983 \r
1984 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK\r
1985 WARNING), we just borrow some other predicates for a\r
1986 what-should-be-good-enough test.  "Cheap" means willing to call it more\r
1987 than once.  Evaluation order is unaffected.\r
1988 \r
1989 \begin{code}\r
1990 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)\r
1991 \end{code}\r
1992 \r
1993 primOpIsDupable means that the use of the primop is small enough to\r
1994 duplicate into different case branches.  See CoreUtils.exprIsDupable.\r
1995 \r
1996 \begin{code}\r
1997 primOpIsDupable (CCallOp _ _ _ _) = False\r
1998 primOpIsDupable op                = not (primOpOutOfLine op)\r
1999 \end{code}\r
2000 \r
2001 \r
2002 \begin{code}\r
2003 primOpCanFail :: PrimOp -> Bool\r
2004 -- Int.\r
2005 primOpCanFail IntQuotOp = True          -- Divide by zero\r
2006 primOpCanFail IntRemOp          = True          -- Divide by zero\r
2007 \r
2008 -- Integer\r
2009 primOpCanFail IntegerQuotRemOp = True           -- Divide by zero\r
2010 primOpCanFail IntegerDivModOp   = True          -- Divide by zero\r
2011 \r
2012 -- Float.  ToDo: tan? tanh?\r
2013 primOpCanFail FloatDivOp        = True          -- Divide by zero\r
2014 primOpCanFail FloatLogOp        = True          -- Log of zero\r
2015 primOpCanFail FloatAsinOp       = True          -- Arg out of domain\r
2016 primOpCanFail FloatAcosOp       = True          -- Arg out of domain\r
2017 \r
2018 -- Double.  ToDo: tan? tanh?\r
2019 primOpCanFail DoubleDivOp       = True          -- Divide by zero\r
2020 primOpCanFail DoubleLogOp       = True          -- Log of zero\r
2021 primOpCanFail DoubleAsinOp      = True          -- Arg out of domain\r
2022 primOpCanFail DoubleAcosOp      = True          -- Arg out of domain\r
2023 \r
2024 primOpCanFail other_op          = False\r
2025 \end{code}\r
2026 \r
2027 And some primops have side-effects and so, for example, must not be\r
2028 duplicated.\r
2029 \r
2030 \begin{code}\r
2031 primOpHasSideEffects :: PrimOp -> Bool\r
2032 \r
2033 primOpHasSideEffects TakeMVarOp        = True\r
2034 primOpHasSideEffects DelayOp           = True\r
2035 primOpHasSideEffects WaitReadOp        = True\r
2036 primOpHasSideEffects WaitWriteOp       = True\r
2037 \r
2038 primOpHasSideEffects ParOp             = True\r
2039 primOpHasSideEffects ForkOp            = True\r
2040 primOpHasSideEffects KillThreadOp      = True\r
2041 primOpHasSideEffects YieldOp           = True\r
2042 primOpHasSideEffects SeqOp             = True\r
2043 \r
2044 primOpHasSideEffects MakeForeignObjOp  = True\r
2045 primOpHasSideEffects WriteForeignObjOp = True\r
2046 primOpHasSideEffects MkWeakOp          = True\r
2047 primOpHasSideEffects DeRefWeakOp       = True\r
2048 primOpHasSideEffects FinalizeWeakOp    = True\r
2049 primOpHasSideEffects MakeStablePtrOp   = True\r
2050 primOpHasSideEffects MakeStableNameOp  = True\r
2051 primOpHasSideEffects EqStablePtrOp     = True  -- SOF\r
2052 primOpHasSideEffects DeRefStablePtrOp  = True  -- ??? JSM & ADR\r
2053 \r
2054 primOpHasSideEffects ParGlobalOp        = True\r
2055 primOpHasSideEffects ParLocalOp         = True\r
2056 primOpHasSideEffects ParAtOp            = True\r
2057 primOpHasSideEffects ParAtAbsOp         = True\r
2058 primOpHasSideEffects ParAtRelOp         = True\r
2059 primOpHasSideEffects ParAtForNowOp      = True\r
2060 primOpHasSideEffects CopyableOp         = True  -- Possibly not.  ASP \r
2061 primOpHasSideEffects NoFollowOp         = True  -- Possibly not.  ASP\r
2062 \r
2063 -- CCall\r
2064 primOpHasSideEffects (CCallOp   _ _ _ _) = True\r
2065 \r
2066 primOpHasSideEffects other = False\r
2067 \end{code}\r
2068 \r
2069 Inline primitive operations that perform calls need wrappers to save\r
2070 any live variables that are stored in caller-saves registers.\r
2071 \r
2072 \begin{code}\r
2073 primOpNeedsWrapper :: PrimOp -> Bool\r
2074 \r
2075 primOpNeedsWrapper (CCallOp _ _ _ _)    = True\r
2076 \r
2077 primOpNeedsWrapper Integer2IntOp        = True\r
2078 primOpNeedsWrapper Integer2WordOp       = True\r
2079 primOpNeedsWrapper IntegerCmpOp         = True\r
2080 primOpNeedsWrapper IntegerCmpIntOp      = True\r
2081 \r
2082 primOpNeedsWrapper FloatExpOp           = True\r
2083 primOpNeedsWrapper FloatLogOp           = True\r
2084 primOpNeedsWrapper FloatSqrtOp          = True\r
2085 primOpNeedsWrapper FloatSinOp           = True\r
2086 primOpNeedsWrapper FloatCosOp           = True\r
2087 primOpNeedsWrapper FloatTanOp           = True\r
2088 primOpNeedsWrapper FloatAsinOp          = True\r
2089 primOpNeedsWrapper FloatAcosOp          = True\r
2090 primOpNeedsWrapper FloatAtanOp          = True\r
2091 primOpNeedsWrapper FloatSinhOp          = True\r
2092 primOpNeedsWrapper FloatCoshOp          = True\r
2093 primOpNeedsWrapper FloatTanhOp          = True\r
2094 primOpNeedsWrapper FloatPowerOp         = True\r
2095 \r
2096 primOpNeedsWrapper DoubleExpOp          = True\r
2097 primOpNeedsWrapper DoubleLogOp          = True\r
2098 primOpNeedsWrapper DoubleSqrtOp         = True\r
2099 primOpNeedsWrapper DoubleSinOp          = True\r
2100 primOpNeedsWrapper DoubleCosOp          = True\r
2101 primOpNeedsWrapper DoubleTanOp          = True\r
2102 primOpNeedsWrapper DoubleAsinOp         = True\r
2103 primOpNeedsWrapper DoubleAcosOp         = True\r
2104 primOpNeedsWrapper DoubleAtanOp         = True\r
2105 primOpNeedsWrapper DoubleSinhOp         = True\r
2106 primOpNeedsWrapper DoubleCoshOp         = True\r
2107 primOpNeedsWrapper DoubleTanhOp         = True\r
2108 primOpNeedsWrapper DoublePowerOp        = True\r
2109 \r
2110 primOpNeedsWrapper MakeStableNameOp     = True\r
2111 primOpNeedsWrapper DeRefStablePtrOp     = True\r
2112 \r
2113 primOpNeedsWrapper DelayOp              = True\r
2114 primOpNeedsWrapper WaitReadOp           = True\r
2115 primOpNeedsWrapper WaitWriteOp          = True\r
2116 \r
2117 primOpNeedsWrapper other_op             = False\r
2118 \end{code}\r
2119 \r
2120 \begin{code}\r
2121 primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead\r
2122 primOpType op\r
2123   = case (primOpInfo op) of\r
2124       Dyadic occ ty ->      dyadic_fun_ty ty\r
2125       Monadic occ ty ->     monadic_fun_ty ty\r
2126       Compare occ ty ->     compare_fun_ty ty\r
2127 \r
2128       GenPrimOp occ tyvars arg_tys res_ty -> \r
2129         mkForAllTys tyvars (mkFunTys arg_tys res_ty)\r
2130 \r
2131 mkPrimOpIdName :: PrimOp -> Id -> Name\r
2132         -- Make the name for the PrimOp's Id\r
2133         -- We have to pass in the Id itself because it's a WiredInId\r
2134         -- and hence recursive\r
2135 mkPrimOpIdName op id\r
2136   = mkWiredInIdName key pREL_GHC occ_name id\r
2137   where\r
2138     occ_name = primOpOcc op\r
2139     key      = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))\r
2140 \r
2141 \r
2142 primOpRdrName :: PrimOp -> RdrName \r
2143 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)\r
2144 \r
2145 primOpOcc :: PrimOp -> OccName\r
2146 primOpOcc op = case (primOpInfo op) of\r
2147                               Dyadic    occ _     -> occ\r
2148                               Monadic   occ _     -> occ\r
2149                               Compare   occ _     -> occ\r
2150                               GenPrimOp occ _ _ _ -> occ\r
2151 \r
2152 -- primOpSig is like primOpType but gives the result split apart:\r
2153 -- (type variables, argument types, result type)\r
2154 \r
2155 primOpSig :: PrimOp -> ([TyVar],[Type],Type)\r
2156 primOpSig op\r
2157   = case (primOpInfo op) of\r
2158       Monadic   occ ty -> ([],     [ty],    ty    )\r
2159       Dyadic    occ ty -> ([],     [ty,ty], ty    )\r
2160       Compare   occ ty -> ([],     [ty,ty], boolTy)\r
2161       GenPrimOp occ tyvars arg_tys res_ty\r
2162                        -> (tyvars, arg_tys, res_ty)\r
2163 \r
2164 -- primOpUsg is like primOpSig but the types it yields are the\r
2165 -- appropriate sigma (i.e., usage-annotated) types,\r
2166 -- as required by the UsageSP inference.\r
2167 \r
2168 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)\r
2169 primOpUsg op\r
2170   = case op of\r
2171 \r
2172       -- Refer to comment by `otherwise' clause; we need consider here\r
2173       -- *only* primops that have arguments or results containing Haskell\r
2174       -- pointers (things that are pointed).  Unpointed values are\r
2175       -- irrelevant to the usage analysis.  The issue is whether pointed\r
2176       -- values may be entered or duplicated by the primop.\r
2177 \r
2178       -- Remember that primops are *never* partially applied.\r
2179 \r
2180       NewArrayOp           -> mangle [mkP, mkM, mkP     ] mkM\r
2181       SameMutableArrayOp   -> mangle [mkP, mkP          ] mkM\r
2182       ReadArrayOp          -> mangle [mkM, mkP, mkP     ] mkM\r
2183       WriteArrayOp         -> mangle [mkM, mkP, mkM, mkP] mkR\r
2184       IndexArrayOp         -> mangle [mkM, mkP          ] mkM\r
2185       UnsafeFreezeArrayOp  -> mangle [mkM, mkP          ] mkM\r
2186       UnsafeThawArrayOp    -> mangle [mkM, mkP          ] mkM\r
2187 \r
2188       NewMutVarOp          -> mangle [mkM, mkP          ] mkM\r
2189       ReadMutVarOp         -> mangle [mkM, mkP          ] mkM\r
2190       WriteMutVarOp        -> mangle [mkM, mkM, mkP     ] mkR\r
2191       SameMutVarOp         -> mangle [mkP, mkP          ] mkM\r
2192 \r
2193       CatchOp              -> --     [mkO, mkO . (inFun mkM mkO)] mkO\r
2194                               mangle [mkM, mkM . (inFun mkM mkM)] mkM\r
2195                               -- might use caught action multiply\r
2196       RaiseOp              -> mangle [mkM               ] mkM\r
2197 \r
2198       NewMVarOp            -> mangle [mkP               ] mkR\r
2199       TakeMVarOp           -> mangle [mkM, mkP          ] mkM\r
2200       PutMVarOp            -> mangle [mkM, mkM, mkP     ] mkR\r
2201       SameMVarOp           -> mangle [mkP, mkP          ] mkM\r
2202       IsEmptyMVarOp        -> mangle [mkP, mkP          ] mkM\r
2203 \r
2204       ForkOp               -> mangle [mkO, mkP          ] mkR\r
2205       KillThreadOp         -> mangle [mkP, mkM, mkP     ] mkR\r
2206 \r
2207       MkWeakOp             -> mangle [mkZ, mkM, mkM, mkP] mkM\r
2208       DeRefWeakOp          -> mangle [mkM, mkP          ] mkM\r
2209       FinalizeWeakOp       -> mangle [mkM, mkP          ] (mkR . (inUB [id,id,inFun mkR mkM]))\r
2210 \r
2211       MakeStablePtrOp      -> mangle [mkM, mkP          ] mkM\r
2212       DeRefStablePtrOp     -> mangle [mkM, mkP          ] mkM\r
2213       EqStablePtrOp        -> mangle [mkP, mkP          ] mkR\r
2214       MakeStableNameOp     -> mangle [mkZ, mkP          ] mkR\r
2215       EqStableNameOp       -> mangle [mkP, mkP          ] mkR\r
2216       StableNameToIntOp    -> mangle [mkP               ] mkR\r
2217 \r
2218       ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ     ] mkR\r
2219 \r
2220       SeqOp                -> mangle [mkO               ] mkR\r
2221       ParOp                -> mangle [mkO               ] mkR\r
2222       ParGlobalOp          -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
2223       ParLocalOp           -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
2224       ParAtOp              -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM\r
2225       ParAtAbsOp           -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
2226       ParAtRelOp           -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM\r
2227       ParAtForNowOp        -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM\r
2228       CopyableOp           -> mangle [mkZ               ] mkR\r
2229       NoFollowOp           -> mangle [mkZ               ] mkR\r
2230 \r
2231       CCallOp _ _ _ _      -> mangle [                  ] mkM\r
2232 \r
2233       -- Things with no Haskell pointers inside: in actuality, usages are\r
2234       -- irrelevant here (hence it doesn't matter that some of these\r
2235       -- apparently permit duplication; since such arguments are never \r
2236       -- ENTERed anyway, the usage annotation they get is entirely irrelevant\r
2237       -- except insofar as it propagates to infect other values that *are*\r
2238       -- pointed.\r
2239 \r
2240       otherwise            -> nomangle\r
2241                                     \r
2242   where mkZ          = mkUsgTy UsOnce  -- pointed argument used zero\r
2243         mkO          = mkUsgTy UsOnce  -- pointed argument used once\r
2244         mkM          = mkUsgTy UsMany  -- pointed argument used multiply\r
2245         mkP          = mkUsgTy UsOnce  -- unpointed argument\r
2246         mkR          = mkUsgTy UsMany  -- unpointed result\r
2247   \r
2248         (tyvars, arg_tys, res_ty)\r
2249                      = primOpSig op\r
2250 \r
2251         nomangle     = (tyvars, map mkP arg_tys, mkR res_ty)\r
2252 \r
2253         mangle fs g  = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)\r
2254 \r
2255         inFun f g ty = case splitFunTy_maybe ty of\r
2256                          Just (a,b) -> mkFunTy (f a) (g b)\r
2257                          Nothing    -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)\r
2258 \r
2259         inUB fs ty  = case splitTyConApp_maybe ty of\r
2260                         Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )\r
2261                                          mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"\r
2262                                                                          ($) fs tys)\r
2263                         Nothing       -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)\r
2264 \end{code}\r
2265 \r
2266 \begin{code}\r
2267 data PrimOpResultInfo\r
2268   = ReturnsPrim     PrimRep\r
2269   | ReturnsAlg      TyCon\r
2270 \r
2271 -- Some PrimOps need not return a manifest primitive or algebraic value\r
2272 -- (i.e. they might return a polymorphic value).  These PrimOps *must*\r
2273 -- be out of line, or the code generator won't work.\r
2274 \r
2275 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo\r
2276 getPrimOpResultInfo op\r
2277   = case (primOpInfo op) of\r
2278       Dyadic  _ ty               -> ReturnsPrim (typePrimRep ty)\r
2279       Monadic _ ty               -> ReturnsPrim (typePrimRep ty)\r
2280       Compare _ ty               -> ReturnsAlg boolTyCon\r
2281       GenPrimOp _ _ _ ty         -> \r
2282         let rep = typePrimRep ty in\r
2283         case rep of\r
2284            PtrRep -> case splitAlgTyConApp_maybe ty of\r
2285                         Nothing -> panic "getPrimOpResultInfo"\r
2286                         Just (tc,_,_) -> ReturnsAlg tc\r
2287            other -> ReturnsPrim other\r
2288 \r
2289 isCompareOp :: PrimOp -> Bool\r
2290 isCompareOp op\r
2291   = case primOpInfo op of\r
2292       Compare _ _ -> True\r
2293       _           -> False\r
2294 \end{code}\r
2295 \r
2296 The commutable ops are those for which we will try to move constants\r
2297 to the right hand side for strength reduction.\r
2298 \r
2299 \begin{code}\r
2300 commutableOp :: PrimOp -> Bool\r
2301 \r
2302 commutableOp CharEqOp     = True\r
2303 commutableOp CharNeOp     = True\r
2304 commutableOp IntAddOp     = True\r
2305 commutableOp IntMulOp     = True\r
2306 commutableOp AndOp        = True\r
2307 commutableOp OrOp         = True\r
2308 commutableOp XorOp        = True\r
2309 commutableOp IntEqOp      = True\r
2310 commutableOp IntNeOp      = True\r
2311 commutableOp IntegerAddOp = True\r
2312 commutableOp IntegerMulOp = True\r
2313 commutableOp IntegerGcdOp = True\r
2314 commutableOp FloatAddOp   = True\r
2315 commutableOp FloatMulOp   = True\r
2316 commutableOp FloatEqOp    = True\r
2317 commutableOp FloatNeOp    = True\r
2318 commutableOp DoubleAddOp  = True\r
2319 commutableOp DoubleMulOp  = True\r
2320 commutableOp DoubleEqOp   = True\r
2321 commutableOp DoubleNeOp   = True\r
2322 commutableOp _            = False\r
2323 \end{code}\r
2324 \r
2325 Utils:\r
2326 \begin{code}\r
2327 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)\r
2328         -- CharRep       -->  ([],  Char#)\r
2329         -- StablePtrRep  -->  ([a], StablePtr# a)\r
2330 mkPrimTyApp tvs kind\r
2331   = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))\r
2332   where\r
2333     tycon      = primRepTyCon kind\r
2334     forall_tvs = take (tyConArity tycon) tvs\r
2335 \r
2336 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty\r
2337 monadic_fun_ty ty = mkFunTy  ty ty\r
2338 compare_fun_ty ty = mkFunTys [ty, ty] boolTy\r
2339 \end{code}\r
2340 \r
2341 Output stuff:\r
2342 \begin{code}\r
2343 pprPrimOp  :: PrimOp -> SDoc\r
2344 \r
2345 pprPrimOp (CCallOp fun is_casm may_gc cconv)\r
2346   = let\r
2347         callconv = text "{-" <> pprCallConv cconv <> text "-}"\r
2348 \r
2349         before\r
2350           | is_casm && may_gc = "casm_GC ``"\r
2351           | is_casm           = "casm ``"\r
2352           | may_gc            = "ccall_GC "\r
2353           | otherwise         = "ccall "\r
2354 \r
2355         after\r
2356           | is_casm   = text "''"\r
2357           | otherwise = empty\r
2358           \r
2359         ppr_dyn =\r
2360           case fun of\r
2361             Right _ -> text "dyn_"\r
2362             _       -> empty\r
2363 \r
2364         ppr_fun =\r
2365          case fun of\r
2366            Right _ -> text "\"\""\r
2367            Left fn -> ptext fn\r
2368          \r
2369     in\r
2370     hcat [ ifPprDebug callconv\r
2371          , text "__", ppr_dyn\r
2372          , text before , ppr_fun , after]\r
2373 \r
2374 pprPrimOp other_op\r
2375   = getPprStyle $ \ sty ->\r
2376    if ifaceStyle sty then       -- For interfaces Print it qualified with PrelGHC.\r
2377         ptext SLIT("PrelGHC.") <> pprOccName occ\r
2378    else\r
2379         pprOccName occ\r
2380   where\r
2381     occ = primOpOcc other_op\r
2382 \end{code}\r