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