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