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