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