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