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