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