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