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