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