ghc/compiler/prelude/PrimOp.lhs

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