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