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