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