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