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