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