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