ghc/compiler/prelude/PrimOp.lhs

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