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