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