ghc/compiler/prelude/PrimOp.lhs

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