ghc/compiler/prelude/PrimOp.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrimOp]{Primitive operations (machine-level)}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module PrimOp (
  10         PrimOp(..), allThePrimOps,
  11         tagOf_PrimOp, -- ToDo: rm
  12         primOp_str,   -- sigh
  13         primOpType, isCompareOp,
  14         commutableOp,
  15
  16         PrimOpResultInfo(..),
  17         getPrimOpResultInfo,
  18
  19         primOpCanTriggerGC, primOpNeedsWrapper,
  20         primOpOkForSpeculation, primOpIsCheap,
  21         fragilePrimOp,
  22         HeapRequirement(..), primOpHeapReq,
  23         StackRequirement(..), primOpStackRequired,
  24
  25        -- export for the Native Code Generator
  26         primOpInfo, -- needed for primOpNameInfo
  27         PrimOpInfo(..),
  28
  29         pprPrimOp, showPrimOp
  30     ) where
  31
  32 IMP_Ubiq(){-uitous-}
  33
  34 import PrimRep          -- most of it
  35 import TysPrim
  36 import TysWiredIn
  37
  38 import CStrings         ( identToC )
  39 import Constants        ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
  40 import HeapOffs         ( addOff, intOff, totHdrSize, HeapOffset )
  41 import Outputable       ( PprStyle, Outputable(..), codeStyle, ifaceStyle )
  42 import PprType          ( pprParendGenType, GenTyVar{-instance Outputable-} )
  43 import Pretty
  44 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  45 import TyCon            ( TyCon{-instances-} )
  46 import Type             ( mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep,
  47                           getAppDataTyConExpandingDicts, SYN_IE(Type)
  48                         )
  49 import TyVar            --( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
  50 import Unique           ( Unique{-instance Eq-} )
  51 import Util             ( panic#, assoc, panic{-ToDo:rm-} )
  52 \end{code}
  53
  54 %************************************************************************
  55 %*                                                                      *
  56 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
  57 %*                                                                      *
  58 %************************************************************************
  59
  60 These are in \tr{state-interface.verb} order.
  61
  62 \begin{code}
  63 data PrimOp
  64     -- dig the FORTRAN/C influence on the names...
  65
  66     -- comparisons:
  67
  68     = CharGtOp   | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp
  69     | IntGtOp    | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp
  70     | WordGtOp   | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp
  71     | AddrGtOp   | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp
  72     | FloatGtOp  | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp
  73     | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
  74
  75     -- Char#-related ops:
  76     | OrdOp | ChrOp
  77
  78     -- Int#-related ops:
  79     -- IntAbsOp unused?? ADR
  80     | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
  81     | IntRemOp | IntNegOp | IntAbsOp
  82
  83     -- Word#-related ops:
  84     | AndOp  | OrOp   | NotOp | XorOp
  85     | SllOp  | SraOp  | SrlOp  -- shift {left,right} {arithmetic,logical}
  86     | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
  87     | Int2WordOp | Word2IntOp -- casts
  88
  89     -- Addr#-related ops:
  90     | Int2AddrOp | Addr2IntOp -- casts
  91
  92     -- Float#-related ops:
  93     | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
  94     | Float2IntOp | Int2FloatOp
  95
  96     | FloatExpOp   | FloatLogOp   | FloatSqrtOp
  97     | FloatSinOp   | FloatCosOp   | FloatTanOp
  98     | FloatAsinOp  | FloatAcosOp  | FloatAtanOp
  99     | FloatSinhOp  | FloatCoshOp  | FloatTanhOp
 100     -- not all machines have these available conveniently:
 101     -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
 102     | FloatPowerOp -- ** op
 103
 104     -- Double#-related ops:
 105     | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
 106     | Double2IntOp | Int2DoubleOp
 107     | Double2FloatOp | Float2DoubleOp
 108
 109     | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp
 110     | DoubleSinOp   | DoubleCosOp   | DoubleTanOp
 111     | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp
 112     | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp
 113     -- not all machines have these available conveniently:
 114     -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
 115     | DoublePowerOp -- ** op
 116
 117     -- Integer (and related...) ops:
 118     -- slightly weird -- to match GMP package.
 119     | IntegerAddOp | IntegerSubOp | IntegerMulOp
 120     | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
 121
 122     | IntegerCmpOp
 123
 124     | Integer2IntOp  | Int2IntegerOp
 125     | Word2IntegerOp
 126     | Addr2IntegerOp -- "Addr" is *always* a literal string
 127     -- ?? gcd, etc?
 128
 129     | FloatEncodeOp  | FloatDecodeOp
 130     | DoubleEncodeOp | DoubleDecodeOp
 131
 132     -- primitive ops for primitive arrays
 133
 134     | NewArrayOp
 135     | NewByteArrayOp PrimRep
 136
 137     | SameMutableArrayOp
 138     | SameMutableByteArrayOp
 139
 140     | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
 141
 142     | ReadByteArrayOp   PrimRep
 143     | WriteByteArrayOp  PrimRep
 144     | IndexByteArrayOp  PrimRep
 145     | IndexOffAddrOp    PrimRep
 146         -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
 147         -- This is just a cheesy encoding of a bunch of ops.
 148         -- Note that ForeignObjRep is not included -- the only way of
 149         -- creating a ForeignObj is with a ccall or casm.
 150     | IndexOffForeignObjOp PrimRep
 151
 152     | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
 153
 154     | NewSynchVarOp -- for MVars and IVars
 155     | TakeMVarOp | PutMVarOp
 156     | ReadIVarOp | WriteIVarOp
 157
 158     | MakeForeignObjOp  -- foreign objects (malloc pointers or any old URL)
 159     | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
 160     | MakeStablePtrOp | DeRefStablePtrOp
 161 \end{code}
 162
 163 A special ``trap-door'' to use in making calls direct to C functions:
 164 \begin{code}
 165     | CCallOp   FAST_STRING     -- An "unboxed" ccall# to this named function
 166                 Bool            -- True <=> really a "casm"
 167                 Bool            -- True <=> might invoke Haskell GC
 168                 [Type]  -- Unboxed argument; the state-token
 169                                 -- argument will have been put *first*
 170                 Type            -- Return type; one of the "StateAnd<blah>#" types
 171
 172     -- (... to be continued ... )
 173 \end{code}
 174
 175 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
 176 (See @primOpInfo@ for details.)
 177
 178 Note: that first arg and part of the result should be the system state
 179 token (which we carry around to fool over-zealous optimisers) but
 180 which isn't actually passed.
 181
 182 For example, we represent
 183 \begin{pseudocode}
 184 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
 185 \end{pseudocode}
 186 by
 187 \begin{pseudocode}
 188 Case
 189   ( Prim
 190       (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
 191        -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
 192       []
 193       [w#, sp# i#]
 194   )
 195   (AlgAlts [ ( FloatPrimAndIoWorld,
 196                  [f#, w#],
 197                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
 198                ) ]
 199              NoDefault
 200   )
 201 \end{pseudocode}
 202
 203 Nota Bene: there are some people who find the empty list of types in
 204 the @Prim@ somewhat puzzling and would represent the above by
 205 \begin{pseudocode}
 206 Case
 207   ( Prim
 208       (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
 209        -- :: /\ alpha1, alpha2 alpha3, alpha4.
 210        --       alpha1 -> alpha2 -> alpha3 -> alpha4
 211       [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
 212       [w#, sp# i#]
 213   )
 214   (AlgAlts [ ( FloatPrimAndIoWorld,
 215                  [f#, w#],
 216                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
 217                ) ]
 218              NoDefault
 219   )
 220 \end{pseudocode}
 221
 222 But, this is a completely different way of using @CCallOp@.  The most
 223 major changes required if we switch to this are in @primOpInfo@, and
 224 the desugarer. The major difficulty is in moving the HeapRequirement
 225 stuff somewhere appropriate.  (The advantage is that we could simplify
 226 @CCallOp@ and record just the number of arguments with corresponding
 227 simplifications in reading pragma unfoldings, the simplifier,
 228 instantiation (etc) of core expressions, ... .  Maybe we should think
 229 about using it this way?? ADR)
 230
 231 \begin{code}
 232     -- (... continued from above ... )
 233
 234     -- one to support "errorIO" (and, thereby, "error")
 235     | ErrorIOPrimOp
 236
 237     -- Operation to test two closure addresses for equality (yes really!)
 238     -- BLAME ALASTAIR REID FOR THIS!  THE REST OF US ARE INNOCENT!
 239     | ReallyUnsafePtrEqualityOp
 240
 241     -- three for parallel stuff
 242     | SeqOp
 243     | ParOp
 244     | ForkOp
 245
 246     -- three for concurrency
 247     | DelayOp
 248     | WaitReadOp
 249     | WaitWriteOp
 250
 251     | ParGlobalOp       -- named global par
 252     | ParLocalOp        -- named local par
 253     | ParAtOp           -- specifies destination of local par
 254     | ParAtAbsOp        -- specifies destination of local par (abs processor)
 255     | ParAtRelOp        -- specifies destination of local par (rel processor)
 256     | ParAtForNowOp     -- specifies initial destination of global par
 257     | CopyableOp        -- marks copyable code
 258     | NoFollowOp        -- marks non-followup expression
 259 \end{code}
 260
 261 Deriving Ix is what we really want! ToDo
 262 (Chk around before deleting...)
 263 \begin{code}
 264 tagOf_PrimOp CharGtOp                         = (ILIT(1) :: FAST_INT)
 265 tagOf_PrimOp CharGeOp                         = ILIT(  2)
 266 tagOf_PrimOp CharEqOp                         = ILIT(  3)
 267 tagOf_PrimOp CharNeOp                         = ILIT(  4)
 268 tagOf_PrimOp CharLtOp                         = ILIT(  5)
 269 tagOf_PrimOp CharLeOp                         = ILIT(  6)
 270 tagOf_PrimOp IntGtOp                          = ILIT(  7)
 271 tagOf_PrimOp IntGeOp                          = ILIT(  8)
 272 tagOf_PrimOp IntEqOp                          = ILIT(  9)
 273 tagOf_PrimOp IntNeOp                          = ILIT( 10)
 274 tagOf_PrimOp IntLtOp                          = ILIT( 11)
 275 tagOf_PrimOp IntLeOp                          = ILIT( 12)
 276 tagOf_PrimOp WordGtOp                         = ILIT( 13)
 277 tagOf_PrimOp WordGeOp                         = ILIT( 14)
 278 tagOf_PrimOp WordEqOp                         = ILIT( 15)
 279 tagOf_PrimOp WordNeOp                         = ILIT( 16)
 280 tagOf_PrimOp WordLtOp                         = ILIT( 17)
 281 tagOf_PrimOp WordLeOp                         = ILIT( 18)
 282 tagOf_PrimOp AddrGtOp                         = ILIT( 19)
 283 tagOf_PrimOp AddrGeOp                         = ILIT( 20)
 284 tagOf_PrimOp AddrEqOp                         = ILIT( 21)
 285 tagOf_PrimOp AddrNeOp                         = ILIT( 22)
 286 tagOf_PrimOp AddrLtOp                         = ILIT( 23)
 287 tagOf_PrimOp AddrLeOp                         = ILIT( 24)
 288 tagOf_PrimOp FloatGtOp                        = ILIT( 25)
 289 tagOf_PrimOp FloatGeOp                        = ILIT( 26)
 290 tagOf_PrimOp FloatEqOp                        = ILIT( 27)
 291 tagOf_PrimOp FloatNeOp                        = ILIT( 28)
 292 tagOf_PrimOp FloatLtOp                        = ILIT( 29)
 293 tagOf_PrimOp FloatLeOp                        = ILIT( 30)
 294 tagOf_PrimOp DoubleGtOp                       = ILIT( 31)
 295 tagOf_PrimOp DoubleGeOp                       = ILIT( 32)
 296 tagOf_PrimOp DoubleEqOp                       = ILIT( 33)
 297 tagOf_PrimOp DoubleNeOp                       = ILIT( 34)
 298 tagOf_PrimOp DoubleLtOp                       = ILIT( 35)
 299 tagOf_PrimOp DoubleLeOp                       = ILIT( 36)
 300 tagOf_PrimOp OrdOp                            = ILIT( 37)
 301 tagOf_PrimOp ChrOp                            = ILIT( 38)
 302 tagOf_PrimOp IntAddOp                         = ILIT( 39)
 303 tagOf_PrimOp IntSubOp                         = ILIT( 40)
 304 tagOf_PrimOp IntMulOp                         = ILIT( 41)
 305 tagOf_PrimOp IntQuotOp                        = ILIT( 42)
 306 tagOf_PrimOp IntRemOp                         = ILIT( 44)
 307 tagOf_PrimOp IntNegOp                         = ILIT( 45)
 308 tagOf_PrimOp IntAbsOp                         = ILIT( 46)
 309 tagOf_PrimOp AndOp                            = ILIT( 47)
 310 tagOf_PrimOp OrOp                             = ILIT( 48)
 311 tagOf_PrimOp NotOp                            = ILIT( 49)
 312 tagOf_PrimOp XorOp                            = ILIT( 50)
 313 tagOf_PrimOp SllOp                            = ILIT( 51)
 314 tagOf_PrimOp SraOp                            = ILIT( 52)
 315 tagOf_PrimOp SrlOp                            = ILIT( 53)
 316 tagOf_PrimOp ISllOp                           = ILIT( 54)
 317 tagOf_PrimOp ISraOp                           = ILIT( 55)
 318 tagOf_PrimOp ISrlOp                           = ILIT( 56)
 319 tagOf_PrimOp Int2WordOp                       = ILIT( 57)
 320 tagOf_PrimOp Word2IntOp                       = ILIT( 58)
 321 tagOf_PrimOp Int2AddrOp                       = ILIT( 59)
 322 tagOf_PrimOp Addr2IntOp                       = ILIT( 60)
 323 tagOf_PrimOp FloatAddOp                       = ILIT( 61)
 324 tagOf_PrimOp FloatSubOp                       = ILIT( 62)
 325 tagOf_PrimOp FloatMulOp                       = ILIT( 63)
 326 tagOf_PrimOp FloatDivOp                       = ILIT( 64)
 327 tagOf_PrimOp FloatNegOp                       = ILIT( 65)
 328 tagOf_PrimOp Float2IntOp                      = ILIT( 66)
 329 tagOf_PrimOp Int2FloatOp                      = ILIT( 67)
 330 tagOf_PrimOp FloatExpOp                       = ILIT( 68)
 331 tagOf_PrimOp FloatLogOp                       = ILIT( 69)
 332 tagOf_PrimOp FloatSqrtOp                      = ILIT( 70)
 333 tagOf_PrimOp FloatSinOp                       = ILIT( 71)
 334 tagOf_PrimOp FloatCosOp                       = ILIT( 72)
 335 tagOf_PrimOp FloatTanOp                       = ILIT( 73)
 336 tagOf_PrimOp FloatAsinOp                      = ILIT( 74)
 337 tagOf_PrimOp FloatAcosOp                      = ILIT( 75)
 338 tagOf_PrimOp FloatAtanOp                      = ILIT( 76)
 339 tagOf_PrimOp FloatSinhOp                      = ILIT( 77)
 340 tagOf_PrimOp FloatCoshOp                      = ILIT( 78)
 341 tagOf_PrimOp FloatTanhOp                      = ILIT( 79)
 342 tagOf_PrimOp FloatPowerOp                     = ILIT( 80)
 343 tagOf_PrimOp DoubleAddOp                      = ILIT( 81)
 344 tagOf_PrimOp DoubleSubOp                      = ILIT( 82)
 345 tagOf_PrimOp DoubleMulOp                      = ILIT( 83)
 346 tagOf_PrimOp DoubleDivOp                      = ILIT( 84)
 347 tagOf_PrimOp DoubleNegOp                      = ILIT( 85)
 348 tagOf_PrimOp Double2IntOp                     = ILIT( 86)
 349 tagOf_PrimOp Int2DoubleOp                     = ILIT( 87)
 350 tagOf_PrimOp Double2FloatOp                   = ILIT( 88)
 351 tagOf_PrimOp Float2DoubleOp                   = ILIT( 89)
 352 tagOf_PrimOp DoubleExpOp                      = ILIT( 90)
 353 tagOf_PrimOp DoubleLogOp                      = ILIT( 91)
 354 tagOf_PrimOp DoubleSqrtOp                     = ILIT( 92)
 355 tagOf_PrimOp DoubleSinOp                      = ILIT( 93)
 356 tagOf_PrimOp DoubleCosOp                      = ILIT( 94)
 357 tagOf_PrimOp DoubleTanOp                      = ILIT( 95)
 358 tagOf_PrimOp DoubleAsinOp                     = ILIT( 96)
 359 tagOf_PrimOp DoubleAcosOp                     = ILIT( 97)
 360 tagOf_PrimOp DoubleAtanOp                     = ILIT( 98)
 361 tagOf_PrimOp DoubleSinhOp                     = ILIT( 99)
 362 tagOf_PrimOp DoubleCoshOp                     = ILIT(100)
 363 tagOf_PrimOp DoubleTanhOp                     = ILIT(101)
 364 tagOf_PrimOp DoublePowerOp                    = ILIT(102)
 365 tagOf_PrimOp IntegerAddOp                     = ILIT(103)
 366 tagOf_PrimOp IntegerSubOp                     = ILIT(104)
 367 tagOf_PrimOp IntegerMulOp                     = ILIT(105)
 368 tagOf_PrimOp IntegerQuotRemOp                 = ILIT(106)
 369 tagOf_PrimOp IntegerDivModOp                  = ILIT(107)
 370 tagOf_PrimOp IntegerNegOp                     = ILIT(108)
 371 tagOf_PrimOp IntegerCmpOp                     = ILIT(109)
 372 tagOf_PrimOp Integer2IntOp                    = ILIT(110)
 373 tagOf_PrimOp Int2IntegerOp                    = ILIT(111)
 374 tagOf_PrimOp Word2IntegerOp                   = ILIT(112)
 375 tagOf_PrimOp Addr2IntegerOp                   = ILIT(113)
 376 tagOf_PrimOp FloatEncodeOp                    = ILIT(114)
 377 tagOf_PrimOp FloatDecodeOp                    = ILIT(115)
 378 tagOf_PrimOp DoubleEncodeOp                   = ILIT(116)
 379 tagOf_PrimOp DoubleDecodeOp                   = ILIT(117)
 380 tagOf_PrimOp NewArrayOp                       = ILIT(118)
 381 tagOf_PrimOp (NewByteArrayOp CharRep)         = ILIT(119)
 382 tagOf_PrimOp (NewByteArrayOp IntRep)          = ILIT(120)
 383 tagOf_PrimOp (NewByteArrayOp AddrRep)         = ILIT(121)
 384 tagOf_PrimOp (NewByteArrayOp FloatRep)        = ILIT(122)
 385 tagOf_PrimOp (NewByteArrayOp DoubleRep)       = ILIT(123)
 386 tagOf_PrimOp SameMutableArrayOp               = ILIT(124)
 387 tagOf_PrimOp SameMutableByteArrayOp           = ILIT(125)
 388 tagOf_PrimOp ReadArrayOp                      = ILIT(126)
 389 tagOf_PrimOp WriteArrayOp                     = ILIT(127)
 390 tagOf_PrimOp IndexArrayOp                     = ILIT(128)
 391 tagOf_PrimOp (ReadByteArrayOp CharRep)        = ILIT(129)
 392 tagOf_PrimOp (ReadByteArrayOp IntRep)         = ILIT(130)
 393 tagOf_PrimOp (ReadByteArrayOp AddrRep)        = ILIT(131)
 394 tagOf_PrimOp (ReadByteArrayOp FloatRep)       = ILIT(132)
 395 tagOf_PrimOp (ReadByteArrayOp DoubleRep)      = ILIT(133)
 396 tagOf_PrimOp (WriteByteArrayOp CharRep)       = ILIT(134)
 397 tagOf_PrimOp (WriteByteArrayOp IntRep)        = ILIT(135)
 398 tagOf_PrimOp (WriteByteArrayOp AddrRep)       = ILIT(136)
 399 tagOf_PrimOp (WriteByteArrayOp FloatRep)      = ILIT(137)
 400 tagOf_PrimOp (WriteByteArrayOp DoubleRep)     = ILIT(138)
 401 tagOf_PrimOp (IndexByteArrayOp CharRep)       = ILIT(139)
 402 tagOf_PrimOp (IndexByteArrayOp IntRep)        = ILIT(140)
 403 tagOf_PrimOp (IndexByteArrayOp AddrRep)       = ILIT(141)
 404 tagOf_PrimOp (IndexByteArrayOp FloatRep)      = ILIT(142)
 405 tagOf_PrimOp (IndexByteArrayOp DoubleRep)     = ILIT(143)
 406 tagOf_PrimOp (IndexOffAddrOp CharRep)         = ILIT(144)
 407 tagOf_PrimOp (IndexOffAddrOp IntRep)          = ILIT(145)
 408 tagOf_PrimOp (IndexOffAddrOp AddrRep)         = ILIT(146)
 409 tagOf_PrimOp (IndexOffAddrOp FloatRep)        = ILIT(147)
 410 tagOf_PrimOp (IndexOffAddrOp DoubleRep)       = ILIT(148)
 411 tagOf_PrimOp (IndexOffForeignObjOp CharRep)   = ILIT(149)
 412 tagOf_PrimOp (IndexOffForeignObjOp IntRep)    = ILIT(150)
 413 tagOf_PrimOp (IndexOffForeignObjOp AddrRep)   = ILIT(151)
 414 tagOf_PrimOp (IndexOffForeignObjOp FloatRep)  = ILIT(152)
 415 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(153)
 416 tagOf_PrimOp UnsafeFreezeArrayOp              = ILIT(154)
 417 tagOf_PrimOp UnsafeFreezeByteArrayOp          = ILIT(155)
 418 tagOf_PrimOp NewSynchVarOp                    = ILIT(156)
 419 tagOf_PrimOp TakeMVarOp                       = ILIT(157)
 420 tagOf_PrimOp PutMVarOp                        = ILIT(158)
 421 tagOf_PrimOp ReadIVarOp                       = ILIT(159)
 422 tagOf_PrimOp WriteIVarOp                      = ILIT(160)
 423 tagOf_PrimOp MakeForeignObjOp                 = ILIT(161)
 424 tagOf_PrimOp WriteForeignObjOp                = ILIT(162)
 425 tagOf_PrimOp MakeStablePtrOp                  = ILIT(163)
 426 tagOf_PrimOp DeRefStablePtrOp                 = ILIT(164)
 427 tagOf_PrimOp (CCallOp _ _ _ _ _)              = ILIT(165)
 428 tagOf_PrimOp ErrorIOPrimOp                    = ILIT(166)
 429 tagOf_PrimOp ReallyUnsafePtrEqualityOp        = ILIT(167)
 430 tagOf_PrimOp SeqOp                            = ILIT(168)
 431 tagOf_PrimOp ParOp                            = ILIT(169)
 432 tagOf_PrimOp ForkOp                           = ILIT(170)
 433 tagOf_PrimOp DelayOp                          = ILIT(171)
 434 tagOf_PrimOp WaitReadOp                       = ILIT(172)
 435 tagOf_PrimOp WaitWriteOp                      = ILIT(173)
 436
 437 tagOf_PrimOp ParGlobalOp                      = ILIT(174)
 438 tagOf_PrimOp ParLocalOp                       = ILIT(175)
 439 tagOf_PrimOp ParAtOp                          = ILIT(176)
 440 tagOf_PrimOp ParAtAbsOp                       = ILIT(177)
 441 tagOf_PrimOp ParAtRelOp                       = ILIT(178)
 442 tagOf_PrimOp ParAtForNowOp                    = ILIT(179)
 443 tagOf_PrimOp CopyableOp                       = ILIT(180)
 444 tagOf_PrimOp NoFollowOp                       = ILIT(181)
 445
 446 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
 447
 448 instance Eq PrimOp where
 449     op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
 450 \end{code}
 451
 452 An @Enum@-derived list would be better; meanwhile... (ToDo)
 453 \begin{code}
 454 allThePrimOps
 455   = [   CharGtOp,
 456         CharGeOp,
 457         CharEqOp,
 458         CharNeOp,
 459         CharLtOp,
 460         CharLeOp,
 461         IntGtOp,
 462         IntGeOp,
 463         IntEqOp,
 464         IntNeOp,
 465         IntLtOp,
 466         IntLeOp,
 467         WordGtOp,
 468         WordGeOp,
 469         WordEqOp,
 470         WordNeOp,
 471         WordLtOp,
 472         WordLeOp,
 473         AddrGtOp,
 474         AddrGeOp,
 475         AddrEqOp,
 476         AddrNeOp,
 477         AddrLtOp,
 478         AddrLeOp,
 479         FloatGtOp,
 480         FloatGeOp,
 481         FloatEqOp,
 482         FloatNeOp,
 483         FloatLtOp,
 484         FloatLeOp,
 485         DoubleGtOp,
 486         DoubleGeOp,
 487         DoubleEqOp,
 488         DoubleNeOp,
 489         DoubleLtOp,
 490         DoubleLeOp,
 491         OrdOp,
 492         ChrOp,
 493         IntAddOp,
 494         IntSubOp,
 495         IntMulOp,
 496         IntQuotOp,
 497         IntRemOp,
 498         IntNegOp,
 499         AndOp,
 500         OrOp,
 501         NotOp,
 502         XorOp,
 503         SllOp,
 504         SraOp,
 505         SrlOp,
 506         ISllOp,
 507         ISraOp,
 508         ISrlOp,
 509         Int2WordOp,
 510         Word2IntOp,
 511         Int2AddrOp,
 512         Addr2IntOp,
 513         FloatAddOp,
 514         FloatSubOp,
 515         FloatMulOp,
 516         FloatDivOp,
 517         FloatNegOp,
 518         Float2IntOp,
 519         Int2FloatOp,
 520         FloatExpOp,
 521         FloatLogOp,
 522         FloatSqrtOp,
 523         FloatSinOp,
 524         FloatCosOp,
 525         FloatTanOp,
 526         FloatAsinOp,
 527         FloatAcosOp,
 528         FloatAtanOp,
 529         FloatSinhOp,
 530         FloatCoshOp,
 531         FloatTanhOp,
 532         FloatPowerOp,
 533         DoubleAddOp,
 534         DoubleSubOp,
 535         DoubleMulOp,
 536         DoubleDivOp,
 537         DoubleNegOp,
 538         Double2IntOp,
 539         Int2DoubleOp,
 540         Double2FloatOp,
 541         Float2DoubleOp,
 542         DoubleExpOp,
 543         DoubleLogOp,
 544         DoubleSqrtOp,
 545         DoubleSinOp,
 546         DoubleCosOp,
 547         DoubleTanOp,
 548         DoubleAsinOp,
 549         DoubleAcosOp,
 550         DoubleAtanOp,
 551         DoubleSinhOp,
 552         DoubleCoshOp,
 553         DoubleTanhOp,
 554         DoublePowerOp,
 555         IntegerAddOp,
 556         IntegerSubOp,
 557         IntegerMulOp,
 558         IntegerQuotRemOp,
 559         IntegerDivModOp,
 560         IntegerNegOp,
 561         IntegerCmpOp,
 562         Integer2IntOp,
 563         Int2IntegerOp,
 564         Word2IntegerOp,
 565         Addr2IntegerOp,
 566         FloatEncodeOp,
 567         FloatDecodeOp,
 568         DoubleEncodeOp,
 569         DoubleDecodeOp,
 570         NewArrayOp,
 571         NewByteArrayOp CharRep,
 572         NewByteArrayOp IntRep,
 573         NewByteArrayOp AddrRep,
 574         NewByteArrayOp FloatRep,
 575         NewByteArrayOp DoubleRep,
 576         SameMutableArrayOp,
 577         SameMutableByteArrayOp,
 578         ReadArrayOp,
 579         WriteArrayOp,
 580         IndexArrayOp,
 581         ReadByteArrayOp CharRep,
 582         ReadByteArrayOp IntRep,
 583         ReadByteArrayOp AddrRep,
 584         ReadByteArrayOp FloatRep,
 585         ReadByteArrayOp DoubleRep,
 586         WriteByteArrayOp CharRep,
 587         WriteByteArrayOp IntRep,
 588         WriteByteArrayOp AddrRep,
 589         WriteByteArrayOp FloatRep,
 590         WriteByteArrayOp DoubleRep,
 591         IndexByteArrayOp CharRep,
 592         IndexByteArrayOp IntRep,
 593         IndexByteArrayOp AddrRep,
 594         IndexByteArrayOp FloatRep,
 595         IndexByteArrayOp DoubleRep,
 596         IndexOffAddrOp CharRep,
 597         IndexOffAddrOp IntRep,
 598         IndexOffAddrOp AddrRep,
 599         IndexOffAddrOp FloatRep,
 600         IndexOffAddrOp DoubleRep,
 601         IndexOffForeignObjOp CharRep,
 602         IndexOffForeignObjOp IntRep,
 603         IndexOffForeignObjOp AddrRep,
 604         IndexOffForeignObjOp FloatRep,
 605         IndexOffForeignObjOp DoubleRep,
 606         UnsafeFreezeArrayOp,
 607         UnsafeFreezeByteArrayOp,
 608         NewSynchVarOp,
 609         ReadArrayOp,
 610         TakeMVarOp,
 611         PutMVarOp,
 612         ReadIVarOp,
 613         WriteIVarOp,
 614         MakeForeignObjOp,
 615         WriteForeignObjOp,
 616         MakeStablePtrOp,
 617         DeRefStablePtrOp,
 618         ReallyUnsafePtrEqualityOp,
 619         ErrorIOPrimOp,
 620         ParGlobalOp,
 621         ParLocalOp,
 622         ParAtOp,
 623         ParAtAbsOp,
 624         ParAtRelOp,
 625         ParAtForNowOp,
 626         CopyableOp,
 627         NoFollowOp,
 628         SeqOp,
 629         ParOp,
 630         ForkOp,
 631         DelayOp,
 632         WaitReadOp,
 633         WaitWriteOp
 634     ]
 635 \end{code}
 636
 637 %************************************************************************
 638 %*                                                                      *
 639 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
 640 %*                                                                      *
 641 %************************************************************************
 642
 643 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
 644 refer to the primitive operation.  The conventional \tr{#}-for-
 645 unboxed ops is added on later.
 646
 647 The reason for the funny characters in the names is so we do not
 648 interfere with the programmer's Haskell name spaces.
 649
 650 We use @PrimKinds@ for the ``type'' information, because they're
 651 (slightly) more convenient to use than @TyCons@.
 652 \begin{code}
 653 data PrimOpInfo
 654   = Dyadic      FAST_STRING     -- string :: T -> T -> T
 655                 Type
 656   | Monadic     FAST_STRING     -- string :: T -> T
 657                 Type
 658   | Compare     FAST_STRING     -- string :: T -> T -> Bool
 659                 Type
 660   | Coercing    FAST_STRING     -- string :: T1 -> T2
 661                 Type
 662                 Type
 663
 664   | PrimResult  FAST_STRING
 665                 [TyVar] [Type] TyCon PrimRep [Type]
 666                 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
 667                 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
 668                 -- D# is a primitive type constructor.
 669                 -- (the kind is the same info as D#, in another convenient form)
 670
 671   | AlgResult   FAST_STRING
 672                 [TyVar] [Type] TyCon [Type]
 673                 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
 674                 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
 675
 676 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
 677 \end{code}
 678
 679 Utility bits:
 680 \begin{code}
 681 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
 682 two_Integer_tys
 683   = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
 684      intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
 685 an_Integer_and_Int_tys
 686   = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
 687      intPrimTy]
 688
 689 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
 690
 691 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
 692
 693 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
 694
 695 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
 696 \end{code}
 697
 698 @primOpInfo@ gives all essential information (from which everything
 699 else, notably a type, can be constructed) for each @PrimOp@.
 700
 701 \begin{code}
 702 primOpInfo :: PrimOp -> PrimOpInfo
 703 \end{code}
 704
 705 There's plenty of this stuff!
 706
 707 %************************************************************************
 708 %*                                                                      *
 709 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
 710 %*                                                                      *
 711 %************************************************************************
 712
 713 \begin{code}
 714 primOpInfo CharGtOp   = Compare SLIT("gtChar#")   charPrimTy
 715 primOpInfo CharGeOp   = Compare SLIT("geChar#")   charPrimTy
 716 primOpInfo CharEqOp   = Compare SLIT("eqChar#")   charPrimTy
 717 primOpInfo CharNeOp   = Compare SLIT("neChar#")   charPrimTy
 718 primOpInfo CharLtOp   = Compare SLIT("ltChar#")   charPrimTy
 719 primOpInfo CharLeOp   = Compare SLIT("leChar#")   charPrimTy
 720
 721 primOpInfo IntGtOp    = Compare SLIT(">#")         intPrimTy
 722 primOpInfo IntGeOp    = Compare SLIT(">=#")        intPrimTy
 723 primOpInfo IntEqOp    = Compare SLIT("==#")        intPrimTy
 724 primOpInfo IntNeOp    = Compare SLIT("/=#")        intPrimTy
 725 primOpInfo IntLtOp    = Compare SLIT("<#")         intPrimTy
 726 primOpInfo IntLeOp    = Compare SLIT("<=#")        intPrimTy
 727
 728 primOpInfo WordGtOp   = Compare SLIT("gtWord#")   wordPrimTy
 729 primOpInfo WordGeOp   = Compare SLIT("geWord#")   wordPrimTy
 730 primOpInfo WordEqOp   = Compare SLIT("eqWord#")   wordPrimTy
 731 primOpInfo WordNeOp   = Compare SLIT("neWord#")   wordPrimTy
 732 primOpInfo WordLtOp   = Compare SLIT("ltWord#")   wordPrimTy
 733 primOpInfo WordLeOp   = Compare SLIT("leWord#")   wordPrimTy
 734
 735 primOpInfo AddrGtOp   = Compare SLIT("gtAddr#")   addrPrimTy
 736 primOpInfo AddrGeOp   = Compare SLIT("geAddr#")   addrPrimTy
 737 primOpInfo AddrEqOp   = Compare SLIT("eqAddr#")   addrPrimTy
 738 primOpInfo AddrNeOp   = Compare SLIT("neAddr#")   addrPrimTy
 739 primOpInfo AddrLtOp   = Compare SLIT("ltAddr#")   addrPrimTy
 740 primOpInfo AddrLeOp   = Compare SLIT("leAddr#")   addrPrimTy
 741
 742 primOpInfo FloatGtOp  = Compare SLIT("gtFloat#")  floatPrimTy
 743 primOpInfo FloatGeOp  = Compare SLIT("geFloat#")  floatPrimTy
 744 primOpInfo FloatEqOp  = Compare SLIT("eqFloat#")  floatPrimTy
 745 primOpInfo FloatNeOp  = Compare SLIT("neFloat#")  floatPrimTy
 746 primOpInfo FloatLtOp  = Compare SLIT("ltFloat#")  floatPrimTy
 747 primOpInfo FloatLeOp  = Compare SLIT("leFloat#")  floatPrimTy
 748
 749 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
 750 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
 751 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
 752 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
 753 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
 754 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
 755 \end{code}
 756
 757 %************************************************************************
 758 %*                                                                      *
 759 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
 760 %*                                                                      *
 761 %************************************************************************
 762
 763 \begin{code}
 764 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
 765 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
 766 \end{code}
 767
 768 %************************************************************************
 769 %*                                                                      *
 770 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
 771 %*                                                                      *
 772 %************************************************************************
 773
 774 \begin{code}
 775 primOpInfo IntAddOp  = Dyadic SLIT("+#")         intPrimTy
 776 primOpInfo IntSubOp  = Dyadic SLIT("-#") intPrimTy
 777 primOpInfo IntMulOp  = Dyadic SLIT("*#") intPrimTy
 778 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")   intPrimTy
 779 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")    intPrimTy
 780
 781 primOpInfo IntNegOp  = Monadic SLIT("negateInt#") intPrimTy
 782 primOpInfo IntAbsOp  = Monadic SLIT("absInt#") intPrimTy
 783 \end{code}
 784
 785 %************************************************************************
 786 %*                                                                      *
 787 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
 788 %*                                                                      *
 789 %************************************************************************
 790
 791 A @Word#@ is an unsigned @Int#@.
 792
 793 \begin{code}
 794 primOpInfo AndOp    = Dyadic  SLIT("and#")      wordPrimTy
 795 primOpInfo OrOp     = Dyadic  SLIT("or#")       wordPrimTy
 796 primOpInfo NotOp    = Monadic SLIT("not#")      wordPrimTy
 797 primOpInfo XorOp    = Monadic SLIT("xor#")      wordPrimTy
 798
 799 primOpInfo SllOp
 800   = PrimResult SLIT("shiftL#")  [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 801 primOpInfo SraOp
 802   = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 803 primOpInfo SrlOp
 804   = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 805
 806 primOpInfo ISllOp
 807   = PrimResult SLIT("iShiftL#")  [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 808 primOpInfo ISraOp
 809   = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 810 primOpInfo ISrlOp
 811   = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 812
 813 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
 814 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
 815 \end{code}
 816
 817 %************************************************************************
 818 %*                                                                      *
 819 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
 820 %*                                                                      *
 821 %************************************************************************
 822
 823 \begin{code}
 824 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
 825 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
 826 \end{code}
 827
 828 %************************************************************************
 829 %*                                                                      *
 830 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
 831 %*                                                                      *
 832 %************************************************************************
 833
 834 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
 835 similar).
 836
 837 \begin{code}
 838 primOpInfo FloatAddOp   = Dyadic    SLIT("plusFloat#")     floatPrimTy
 839 primOpInfo FloatSubOp   = Dyadic    SLIT("minusFloat#")   floatPrimTy
 840 primOpInfo FloatMulOp   = Dyadic    SLIT("timesFloat#")   floatPrimTy
 841 primOpInfo FloatDivOp   = Dyadic    SLIT("divideFloat#")  floatPrimTy
 842 primOpInfo FloatNegOp   = Monadic   SLIT("negateFloat#")  floatPrimTy
 843
 844 primOpInfo Float2IntOp  = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
 845 primOpInfo Int2FloatOp  = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
 846
 847 primOpInfo FloatExpOp   = Monadic   SLIT("expFloat#")      floatPrimTy
 848 primOpInfo FloatLogOp   = Monadic   SLIT("logFloat#")      floatPrimTy
 849 primOpInfo FloatSqrtOp  = Monadic   SLIT("sqrtFloat#")     floatPrimTy
 850 primOpInfo FloatSinOp   = Monadic   SLIT("sinFloat#")      floatPrimTy
 851 primOpInfo FloatCosOp   = Monadic   SLIT("cosFloat#")      floatPrimTy
 852 primOpInfo FloatTanOp   = Monadic   SLIT("tanFloat#")      floatPrimTy
 853 primOpInfo FloatAsinOp  = Monadic   SLIT("asinFloat#")     floatPrimTy
 854 primOpInfo FloatAcosOp  = Monadic   SLIT("acosFloat#")     floatPrimTy
 855 primOpInfo FloatAtanOp  = Monadic   SLIT("atanFloat#")     floatPrimTy
 856 primOpInfo FloatSinhOp  = Monadic   SLIT("sinhFloat#")     floatPrimTy
 857 primOpInfo FloatCoshOp  = Monadic   SLIT("coshFloat#")     floatPrimTy
 858 primOpInfo FloatTanhOp  = Monadic   SLIT("tanhFloat#")     floatPrimTy
 859 primOpInfo FloatPowerOp = Dyadic    SLIT("powerFloat#")   floatPrimTy
 860 \end{code}
 861
 862 %************************************************************************
 863 %*                                                                      *
 864 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
 865 %*                                                                      *
 866 %************************************************************************
 867
 868 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
 869 similar).
 870
 871 \begin{code}
 872 primOpInfo DoubleAddOp  = Dyadic    SLIT("+##")   doublePrimTy
 873 primOpInfo DoubleSubOp  = Dyadic    SLIT("-##")  doublePrimTy
 874 primOpInfo DoubleMulOp  = Dyadic    SLIT("*##")  doublePrimTy
 875 primOpInfo DoubleDivOp  = Dyadic    SLIT("/##") doublePrimTy
 876 primOpInfo DoubleNegOp  = Monadic   SLIT("negateDouble#") doublePrimTy
 877
 878 primOpInfo Double2IntOp     = Coercing SLIT("double2Int#")   doublePrimTy intPrimTy
 879 primOpInfo Int2DoubleOp     = Coercing SLIT("int2Double#")   intPrimTy doublePrimTy
 880
 881 primOpInfo Double2FloatOp   = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
 882 primOpInfo Float2DoubleOp   = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
 883
 884 primOpInfo DoubleExpOp  = Monadic   SLIT("expDouble#")     doublePrimTy
 885 primOpInfo DoubleLogOp  = Monadic   SLIT("logDouble#")     doublePrimTy
 886 primOpInfo DoubleSqrtOp = Monadic   SLIT("sqrtDouble#")   doublePrimTy
 887 primOpInfo DoubleSinOp  = Monadic   SLIT("sinDouble#")     doublePrimTy
 888 primOpInfo DoubleCosOp  = Monadic   SLIT("cosDouble#")     doublePrimTy
 889 primOpInfo DoubleTanOp  = Monadic   SLIT("tanDouble#")     doublePrimTy
 890 primOpInfo DoubleAsinOp = Monadic   SLIT("asinDouble#")   doublePrimTy
 891 primOpInfo DoubleAcosOp = Monadic   SLIT("acosDouble#")   doublePrimTy
 892 primOpInfo DoubleAtanOp = Monadic   SLIT("atanDouble#")   doublePrimTy
 893 primOpInfo DoubleSinhOp = Monadic   SLIT("sinhDouble#")   doublePrimTy
 894 primOpInfo DoubleCoshOp = Monadic   SLIT("coshDouble#")   doublePrimTy
 895 primOpInfo DoubleTanhOp = Monadic   SLIT("tanhDouble#")   doublePrimTy
 896 primOpInfo DoublePowerOp= Dyadic    SLIT("**##")  doublePrimTy
 897 \end{code}
 898
 899 %************************************************************************
 900 %*                                                                      *
 901 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
 902 %*                                                                      *
 903 %************************************************************************
 904
 905 \begin{code}
 906 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
 907
 908 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
 909 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
 910 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
 911
 912 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
 913
 914 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
 915 primOpInfo IntegerDivModOp  = integerDyadic2Results SLIT("divModInteger#")
 916
 917 primOpInfo Integer2IntOp
 918   = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
 919
 920 primOpInfo Int2IntegerOp
 921   = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
 922
 923 primOpInfo Word2IntegerOp
 924   = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
 925
 926 primOpInfo Addr2IntegerOp
 927   = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
 928 \end{code}
 929
 930 Encoding and decoding of floating-point numbers is sorta
 931 Integer-related.
 932
 933 \begin{code}
 934 primOpInfo FloatEncodeOp
 935   = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
 936          floatPrimTyCon FloatRep []
 937
 938 primOpInfo DoubleEncodeOp
 939   = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
 940         doublePrimTyCon DoubleRep []
 941
 942 primOpInfo FloatDecodeOp
 943   = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
 944
 945 primOpInfo DoubleDecodeOp
 946   = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
 947 \end{code}
 948
 949 %************************************************************************
 950 %*                                                                      *
 951 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
 952 %*                                                                      *
 953 %************************************************************************
 954
 955 \begin{code}
 956 primOpInfo NewArrayOp
 957   = let {
 958         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
 959     } in
 960     AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
 961                                 stateAndMutableArrayPrimTyCon [s, elt]
 962
 963 primOpInfo (NewByteArrayOp kind)
 964   = let
 965         s = alphaTy; s_tv = alphaTyVar
 966
 967         (str, _, prim_tycon) = getPrimRepInfo kind
 968
 969         op_str         = _PK_ ("new" ++ str ++ "Array#")
 970     in
 971     AlgResult op_str [s_tv]
 972         [intPrimTy, mkStatePrimTy s]
 973         stateAndMutableByteArrayPrimTyCon [s]
 974
 975 ---------------------------------------------------------------------------
 976
 977 primOpInfo SameMutableArrayOp
 978   = let {
 979         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
 980         mut_arr_ty = mkMutableArrayPrimTy s elt
 981     } in
 982     AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
 983                                    boolTyCon []
 984
 985 primOpInfo SameMutableByteArrayOp
 986   = let {
 987         s = alphaTy; s_tv = alphaTyVar;
 988         mut_arr_ty = mkMutableByteArrayPrimTy s
 989     } in
 990     AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
 991                                    boolTyCon []
 992
 993 ---------------------------------------------------------------------------
 994 -- Primitive arrays of Haskell pointers:
 995
 996 primOpInfo ReadArrayOp
 997   = let {
 998         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
 999     } in
1000     AlgResult SLIT("readArray#") [s_tv, elt_tv]
1001         [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1002         stateAndPtrPrimTyCon [s, elt]
1003
1004
1005 primOpInfo WriteArrayOp
1006   = let {
1007         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1008     } in
1009     PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1010         [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1011         statePrimTyCon VoidRep [s]
1012
1013 primOpInfo IndexArrayOp
1014   = let { elt = alphaTy; elt_tv = alphaTyVar } in
1015     AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1016                                    liftTyCon [elt]
1017
1018 ---------------------------------------------------------------------------
1019 -- Primitive arrays full of unboxed bytes:
1020
1021 primOpInfo (ReadByteArrayOp kind)
1022   = let
1023         s = alphaTy; s_tv = alphaTyVar
1024
1025         (str, _, prim_tycon) = getPrimRepInfo kind
1026
1027         op_str         = _PK_ ("read" ++ str ++ "Array#")
1028         relevant_tycon = assoc "primOpInfo" tbl kind
1029     in
1030     AlgResult op_str [s_tv]
1031         [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1032         relevant_tycon [s]
1033   where
1034     tbl = [ (CharRep,    stateAndCharPrimTyCon),
1035             (IntRep,     stateAndIntPrimTyCon),
1036             (AddrRep,    stateAndAddrPrimTyCon),
1037             (FloatRep,   stateAndFloatPrimTyCon),
1038             (DoubleRep, stateAndDoublePrimTyCon) ]
1039
1040   -- How come there's no Word byte arrays? ADR
1041
1042 primOpInfo (WriteByteArrayOp kind)
1043   = let
1044         s = alphaTy; s_tv = alphaTyVar
1045
1046         (str, prim_ty, _) = getPrimRepInfo kind
1047         op_str = _PK_ ("write" ++ str ++ "Array#")
1048     in
1049     -- NB: *Prim*Result --
1050     PrimResult op_str [s_tv]
1051         [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1052         statePrimTyCon VoidRep [s]
1053
1054 primOpInfo (IndexByteArrayOp kind)
1055   = let
1056         (str, _, prim_tycon) = getPrimRepInfo kind
1057         op_str = _PK_ ("index" ++ str ++ "Array#")
1058     in
1059     -- NB: *Prim*Result --
1060     PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1061
1062 primOpInfo (IndexOffAddrOp kind)
1063   = let
1064         (str, _, prim_tycon) = getPrimRepInfo kind
1065         op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1066     in
1067     PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1068
1069 primOpInfo (IndexOffForeignObjOp kind)
1070   = let
1071         (str, _, prim_tycon) = getPrimRepInfo kind
1072         op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1073     in
1074     PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1075
1076 ---------------------------------------------------------------------------
1077 primOpInfo UnsafeFreezeArrayOp
1078   = let {
1079         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1080     } in
1081     AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1082         [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1083         stateAndArrayPrimTyCon [s, elt]
1084
1085 primOpInfo UnsafeFreezeByteArrayOp
1086   = let { s = alphaTy; s_tv = alphaTyVar } in
1087     AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1088         [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1089         stateAndByteArrayPrimTyCon [s]
1090 \end{code}
1091
1092 %************************************************************************
1093 %*                                                                      *
1094 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1095 %*                                                                      *
1096 %************************************************************************
1097
1098 \begin{code}
1099 primOpInfo NewSynchVarOp
1100   = let {
1101         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1102     } in
1103     AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1104                                 stateAndSynchVarPrimTyCon [s, elt]
1105
1106 primOpInfo TakeMVarOp
1107   = let {
1108         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1109     } in
1110     AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1111         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1112         stateAndPtrPrimTyCon [s, elt]
1113
1114 primOpInfo PutMVarOp
1115   = let {
1116         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1117     } in
1118     AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1119         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1120         statePrimTyCon [s]
1121
1122 primOpInfo ReadIVarOp
1123   = let {
1124         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1125     } in
1126     AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1127         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1128         stateAndPtrPrimTyCon [s, elt]
1129
1130 primOpInfo WriteIVarOp
1131   = let {
1132         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1133     } in
1134     AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1135         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1136         statePrimTyCon [s]
1137
1138 \end{code}
1139
1140 %************************************************************************
1141 %*                                                                      *
1142 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1143 %*                                                                      *
1144 %************************************************************************
1145
1146 \begin{code}
1147
1148 primOpInfo DelayOp
1149   = let {
1150         s = alphaTy; s_tv = alphaTyVar
1151     } in
1152     PrimResult SLIT("delay#") [s_tv]
1153         [intPrimTy, mkStatePrimTy s]
1154         statePrimTyCon VoidRep [s]
1155
1156 primOpInfo WaitReadOp
1157   = let {
1158         s = alphaTy; s_tv = alphaTyVar
1159     } in
1160     PrimResult SLIT("waitRead#") [s_tv]
1161         [intPrimTy, mkStatePrimTy s]
1162         statePrimTyCon VoidRep [s]
1163
1164 primOpInfo WaitWriteOp
1165   = let {
1166         s = alphaTy; s_tv = alphaTyVar
1167     } in
1168     PrimResult SLIT("waitWrite#") [s_tv]
1169         [intPrimTy, mkStatePrimTy s]
1170         statePrimTyCon VoidRep [s]
1171 \end{code}
1172
1173 %************************************************************************
1174 %*                                                                      *
1175 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1176 %*                                                                      *
1177 %************************************************************************
1178
1179 Not everything should/can be in the Haskell heap. As an example, in an
1180 image processing application written in Haskell, you really would like
1181 to avoid heaving huge images between different space or generations of
1182 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1183 which refer to some externally allocated structure/value. Using @ForeignObj@,
1184 just a reference to an image is present in the heap, the image could then
1185 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1186 a completely separate address space alltogether.
1187
1188 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1189 associated with the object is invoked (currently, each ForeignObj has a
1190 direct reference to its finaliser).  -- SOF
1191
1192 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1193
1194 \begin{pseudocode}
1195 makeForeignObj# :: Addr#  -- foreign object
1196                 -> Addr#  -- ptr to its finaliser routine
1197                 -> StateAndForeignObj# _RealWorld# ForeignObj#
1198 \end{pseudocode}
1199
1200
1201 \begin{code}
1202 primOpInfo MakeForeignObjOp
1203   = AlgResult SLIT("makeForeignObj#") []
1204         [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1205         stateAndForeignObjPrimTyCon [realWorldTy]
1206 \end{code}
1207
1208 [Experimental--SOF]
1209 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1210 the external object wrapped up inside a @ForeignObj@. This primitive is used
1211 when a mixed programming interface of implicit and explicit de-allocation is used,
1212 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1213 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1214 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1215 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1216 We deal with this situation, by allowing the programmer to destructively modify
1217 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1218 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1219
1220 \begin{pseudocode}
1221 writeForeignObj# :: ForeignObj#  -- foreign object
1222                 -> Addr#        -- new data value
1223                 -> StateAndForeignObj# _RealWorld# ForeignObj#
1224 \end{pseudocode}
1225
1226 \begin{code}
1227 primOpInfo WriteForeignObjOp
1228  = let {
1229         s = alphaTy; s_tv = alphaTyVar
1230     } in
1231    PrimResult SLIT("writeForeignObj#") [s_tv]
1232         [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1233         statePrimTyCon VoidRep [s]
1234 \end{code}
1235
1236 %************************************************************************
1237 %*                                                                      *
1238 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1239 %*                                                                      *
1240 %************************************************************************
1241
1242 A {\em stable pointer} is an index into a table of pointers into the
1243 heap.  Since the garbage collector is told about stable pointers, it
1244 is safe to pass a stable pointer to external systems such as C
1245 routines.
1246
1247 Here's what the operations and types are supposed to be (from
1248 state-interface document).
1249
1250 \begin{verbatim}
1251 makeStablePtr#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1252 freeStablePtr#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1253 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1254 \end{verbatim}
1255
1256 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1257 operation since it doesn't (directly) involve IO operations.  The
1258 reason is that if some optimisation pass decided to duplicate calls to
1259 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1260 massive space leak can result.  Putting it into the PrimIO monad
1261 prevents this.  (Another reason for putting them in a monad is to
1262 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1263 operation.)
1264
1265 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1266 besides, it's not likely to be used from Haskell) so it's not a
1267 primop.
1268
1269 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1270
1271 \begin{code}
1272 primOpInfo MakeStablePtrOp
1273   = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1274         [alphaTy, realWorldStatePrimTy]
1275         stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1276
1277 primOpInfo DeRefStablePtrOp
1278   = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1279         [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1280         stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1281 \end{code}
1282
1283 %************************************************************************
1284 %*                                                                      *
1285 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1286 %*                                                                      *
1287 %************************************************************************
1288
1289 [Alastair Reid is to blame for this!]
1290
1291 These days, (Glasgow) Haskell seems to have a bit of everything from
1292 other languages: strict operations, mutable variables, sequencing,
1293 pointers, etc.  About the only thing left is LISP's ability to test
1294 for pointer equality.  So, let's add it in!
1295
1296 \begin{verbatim}
1297 reallyUnsafePtrEquality :: a -> a -> Int#
1298 \end{verbatim}
1299
1300 which tests any two closures (of the same type) to see if they're the
1301 same.  (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1302 difficulties of trying to box up the result.)
1303
1304 NB This is {\em really unsafe\/} because even something as trivial as
1305 a garbage collection might change the answer by removing indirections.
1306 Still, no-one's forcing you to use it.  If you're worried about little
1307 things like loss of referential transparency, you might like to wrap
1308 it all up in a monad-like thing as John O'Donnell and John Hughes did
1309 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1310 Proceedings?)
1311
1312 I'm thinking of using it to speed up a critical equality test in some
1313 graphics stuff in a context where the possibility of saying that
1314 denotationally equal things aren't isn't a problem (as long as it
1315 doesn't happen too often.)  ADR
1316
1317 To Will: Jim said this was already in, but I can't see it so I'm
1318 adding it.  Up to you whether you add it.  (Note that this could have
1319 been readily implemented using a @veryDangerousCCall@ before they were
1320 removed...)
1321
1322 \begin{code}
1323 primOpInfo ReallyUnsafePtrEqualityOp
1324   = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1325         [alphaTy, alphaTy] intPrimTyCon IntRep []
1326 \end{code}
1327
1328 %************************************************************************
1329 %*                                                                      *
1330 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1331 %*                                                                      *
1332 %************************************************************************
1333
1334 \begin{code}
1335 primOpInfo SeqOp        -- seq# :: a -> Int#
1336   = PrimResult SLIT("seq#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1337
1338 primOpInfo ParOp        -- par# :: a -> Int#
1339   = PrimResult SLIT("par#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1340
1341 primOpInfo ForkOp       -- fork# :: a -> Int#
1342   = PrimResult SLIT("fork#")    [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1343
1344 \end{code}
1345
1346 \begin{code}
1347 -- HWL: The first 4 Int# in all par... annotations denote:
1348 --   name, granularity info, size of result, degree of parallelism
1349 --      Same  structure as _seq_ i.e. returns Int#
1350
1351 primOpInfo ParGlobalOp  -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1352   = PrimResult SLIT("parGlobal#")       [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1353
1354 primOpInfo ParLocalOp   -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1355   = PrimResult SLIT("parLocal#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1356
1357 primOpInfo ParAtOp      -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1358   = PrimResult SLIT("parAt#")   [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep []   -- liftTyCon [gammaTy]
1359
1360 primOpInfo ParAtAbsOp   -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1361   = PrimResult SLIT("parAtAbs#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1362
1363 primOpInfo ParAtRelOp   -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1364   = PrimResult SLIT("parAtRel#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1365
1366 primOpInfo ParAtForNowOp        -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1367   = PrimResult SLIT("parAtForNow#")     [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep []   -- liftTyCon [gammaTy]
1368
1369 primOpInfo CopyableOp   -- copyable# :: a -> a
1370   = PrimResult SLIT("copyable#")        [alphaTyVar] [alphaTy] intPrimTyCon IntRep []   -- liftTyCon [alphaTy]
1371
1372 primOpInfo NoFollowOp   -- noFollow# :: a -> a
1373   = PrimResult SLIT("noFollow#")        [alphaTyVar] [alphaTy] intPrimTyCon IntRep []   -- liftTyCon [alphaTy]
1374 \end{code}
1375
1376 %************************************************************************
1377 %*                                                                      *
1378 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1379 %*                                                                      *
1380 %************************************************************************
1381
1382 \begin{code}
1383 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1384   = PrimResult SLIT("errorIO#") []
1385         [primio_ish_ty unitTy]
1386         statePrimTyCon VoidRep [realWorldTy]
1387   where
1388     primio_ish_ty result
1389       = mkFunTy (mkStatePrimTy realWorldTy) (mkSTretTy realWorldTy result)
1390 \end{code}
1391
1392 %************************************************************************
1393 %*                                                                      *
1394 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1395 %*                                                                      *
1396 %************************************************************************
1397
1398 \begin{code}
1399 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1400   = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1401   where
1402     (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
1403
1404 #ifdef DEBUG
1405 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1406 #endif
1407 \end{code}
1408
1409 %************************************************************************
1410 %*                                                                      *
1411 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1412 %*                                                                      *
1413 %************************************************************************
1414
1415 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1416 with @Integers@ can trigger GC.  Here we describe the heap requirements
1417 of the various @PrimOps@.  For most, no heap is required.  For a few,
1418 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1419 be combined with the rest of the heap usage in the basic block.  For an
1420 unfortunate few, some unknown amount of heap is required (these are the
1421 ops which can trigger GC).
1422
1423 \begin{code}
1424 data HeapRequirement
1425     = NoHeapRequired
1426     | FixedHeapRequired HeapOffset
1427     | VariableHeapRequired
1428
1429 primOpHeapReq :: PrimOp -> HeapRequirement
1430
1431 primOpHeapReq NewArrayOp        = VariableHeapRequired
1432 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1433
1434 primOpHeapReq IntegerAddOp      = VariableHeapRequired
1435 primOpHeapReq IntegerSubOp      = VariableHeapRequired
1436 primOpHeapReq IntegerMulOp      = VariableHeapRequired
1437 primOpHeapReq IntegerQuotRemOp  = VariableHeapRequired
1438 primOpHeapReq IntegerDivModOp   = VariableHeapRequired
1439 primOpHeapReq IntegerNegOp      = VariableHeapRequired
1440 primOpHeapReq Int2IntegerOp     = FixedHeapRequired
1441                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1442                                           (intOff mIN_MP_INT_SIZE))
1443 primOpHeapReq Word2IntegerOp    = FixedHeapRequired
1444                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1445                                           (intOff mIN_MP_INT_SIZE))
1446 primOpHeapReq Addr2IntegerOp    = VariableHeapRequired
1447 primOpHeapReq FloatDecodeOp     = FixedHeapRequired
1448                                   (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1449                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1450                                           (intOff mIN_MP_INT_SIZE)))
1451 primOpHeapReq DoubleDecodeOp    = FixedHeapRequired
1452                                   (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1453                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1454                                           (intOff mIN_MP_INT_SIZE)))
1455
1456 {-
1457   ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1458   or if it returns a ForeignObj.
1459
1460   Hmm..the allocation for makeForeignObj# is known (and fixed), so
1461   why dod we need to be so indeterminate about it? --SOF
1462 -}
1463 primOpHeapReq (CCallOp _ _ mayGC@True  _ _) = VariableHeapRequired
1464 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1465
1466 primOpHeapReq MakeForeignObjOp  = VariableHeapRequired
1467 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1468
1469 -- this occasionally has to expand the Stable Pointer table
1470 primOpHeapReq MakeStablePtrOp   = VariableHeapRequired
1471
1472 -- These four only need heap space with the native code generator
1473 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1474
1475 primOpHeapReq IntegerCmpOp      = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1476 primOpHeapReq Integer2IntOp     = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1477 primOpHeapReq FloatEncodeOp     = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1478 primOpHeapReq DoubleEncodeOp    = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1479
1480 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1481 primOpHeapReq NewSynchVarOp     = FixedHeapRequired
1482                                   (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1483
1484 -- Sparking ops no longer allocate any heap; however, _fork_ may
1485 -- require a context switch to clear space in the required thread
1486 -- pool, and that requires liveness information.
1487
1488 primOpHeapReq ParOp             = NoHeapRequired
1489 primOpHeapReq ForkOp            = VariableHeapRequired
1490
1491 -- A SeqOp requires unknown space to evaluate its argument
1492 primOpHeapReq SeqOp             = VariableHeapRequired
1493
1494 -- GranSim sparks are stgMalloced i.e. no heap required
1495 primOpHeapReq ParGlobalOp       = NoHeapRequired
1496 primOpHeapReq ParLocalOp        = NoHeapRequired
1497 primOpHeapReq ParAtOp           = NoHeapRequired
1498 primOpHeapReq ParAtAbsOp        = NoHeapRequired
1499 primOpHeapReq ParAtRelOp        = NoHeapRequired
1500 primOpHeapReq ParAtForNowOp     = NoHeapRequired
1501 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1502 primOpHeapReq CopyableOp        = NoHeapRequired
1503 primOpHeapReq NoFollowOp        = NoHeapRequired
1504
1505 primOpHeapReq other_op          = NoHeapRequired
1506 \end{code}
1507
1508 The amount of stack required by primops.
1509
1510 \begin{code}
1511 data StackRequirement
1512   = NoStackRequired
1513   | FixedStackRequired Int {-AStack-} Int {-BStack-}
1514   | VariableStackRequired
1515
1516 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1517 primOpStackRequired _     = VariableStackRequired
1518 -- ToDo: be more specific for certain primops (currently only used for seq)
1519 \end{code}
1520
1521 Primops which can trigger GC have to be called carefully.
1522 In particular, their arguments are guaranteed to be in registers,
1523 and a liveness mask tells which regs are live.
1524
1525 \begin{code}
1526 primOpCanTriggerGC op
1527   = case op of
1528         TakeMVarOp  -> True
1529         ReadIVarOp  -> True
1530         DelayOp     -> True
1531         WaitReadOp  -> True
1532         WaitWriteOp -> True
1533         _           ->
1534             case primOpHeapReq op of
1535                 VariableHeapRequired -> True
1536                 _                    -> False
1537 \end{code}
1538
1539 Sometimes we may choose to execute a PrimOp even though it isn't
1540 certain that its result will be required; ie execute them
1541 ``speculatively''.  The same thing as ``cheap eagerness.'' Usually
1542 this is OK, because PrimOps are usually cheap, but it isn't OK for
1543 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1544
1545 See also @primOpIsCheap@ (below).
1546
1547 There should be no worries about side effects; that's all taken care
1548 of by data dependencies.
1549
1550 \begin{code}
1551 primOpOkForSpeculation :: PrimOp -> Bool
1552
1553 -- Int.
1554 primOpOkForSpeculation IntQuotOp        = False         -- Divide by zero
1555 primOpOkForSpeculation IntRemOp         = False         -- Divide by zero
1556
1557 -- Integer
1558 primOpOkForSpeculation IntegerQuotRemOp = False         -- Divide by zero
1559 primOpOkForSpeculation IntegerDivModOp  = False         -- Divide by zero
1560
1561 -- Float.  ToDo: tan? tanh?
1562 primOpOkForSpeculation FloatDivOp       = False         -- Divide by zero
1563 primOpOkForSpeculation FloatLogOp       = False         -- Log of zero
1564 primOpOkForSpeculation FloatAsinOp      = False         -- Arg out of domain
1565 primOpOkForSpeculation FloatAcosOp      = False         -- Arg out of domain
1566
1567 -- Double.  ToDo: tan? tanh?
1568 primOpOkForSpeculation DoubleDivOp      = False         -- Divide by zero
1569 primOpOkForSpeculation DoubleLogOp      = False         -- Log of zero
1570 primOpOkForSpeculation DoubleAsinOp     = False         -- Arg out of domain
1571 primOpOkForSpeculation DoubleAcosOp     = False         -- Arg out of domain
1572
1573 -- CCall
1574 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False       -- Could be expensive!
1575
1576 -- errorIO#
1577 primOpOkForSpeculation ErrorIOPrimOp    = False         -- Could be disastrous!
1578
1579 -- parallel
1580 primOpOkForSpeculation ParOp            = False         -- Could be expensive!
1581 primOpOkForSpeculation ForkOp           = False         -- Likewise
1582 primOpOkForSpeculation SeqOp            = False         -- Likewise
1583
1584 primOpOkForSpeculation ParGlobalOp      = False         -- Could be expensive!
1585 primOpOkForSpeculation ParLocalOp       = False         -- Could be expensive!
1586 primOpOkForSpeculation ParAtOp          = False         -- Could be expensive!
1587 primOpOkForSpeculation ParAtAbsOp       = False         -- Could be expensive!
1588 primOpOkForSpeculation ParAtRelOp       = False         -- Could be expensive!
1589 primOpOkForSpeculation ParAtForNowOp    = False         -- Could be expensive!
1590 primOpOkForSpeculation CopyableOp       = False         -- only tags closure
1591 primOpOkForSpeculation NoFollowOp       = False         -- only tags closure
1592
1593 -- The default is "yes it's ok for speculation"
1594 primOpOkForSpeculation other_op         = True
1595 \end{code}
1596
1597 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK
1598 WARNING), we just borrow some other predicates for a
1599 what-should-be-good-enough test.
1600 \begin{code}
1601 primOpIsCheap op
1602   = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1603 \end{code}
1604
1605 And some primops have side-effects and so, for example, must not be
1606 duplicated.
1607
1608 \begin{code}
1609 fragilePrimOp :: PrimOp -> Bool
1610
1611 fragilePrimOp ParOp = True
1612 fragilePrimOp ForkOp = True
1613 fragilePrimOp SeqOp = True
1614 fragilePrimOp MakeForeignObjOp  = True  -- SOF
1615 fragilePrimOp WriteForeignObjOp = True  -- SOF
1616 fragilePrimOp MakeStablePtrOp  = True
1617 fragilePrimOp DeRefStablePtrOp = True  -- ??? JSM & ADR
1618
1619 fragilePrimOp ParGlobalOp = True
1620 fragilePrimOp ParLocalOp = True
1621 fragilePrimOp ParAtOp = True
1622 fragilePrimOp ParAtAbsOp = True
1623 fragilePrimOp ParAtRelOp = True
1624 fragilePrimOp ParAtForNowOp = True
1625 fragilePrimOp CopyableOp = True  -- Possibly not.  ASP
1626 fragilePrimOp NoFollowOp = True  -- Possibly not.  ASP
1627
1628 fragilePrimOp other = False
1629 \end{code}
1630
1631 Primitive operations that perform calls need wrappers to save any live variables
1632 that are stored in caller-saves registers
1633
1634 \begin{code}
1635 primOpNeedsWrapper :: PrimOp -> Bool
1636
1637 primOpNeedsWrapper (CCallOp _ _ _ _ _)  = True
1638
1639 primOpNeedsWrapper NewArrayOp           = True  -- ToDo: for nativeGen only!(JSM)
1640 primOpNeedsWrapper (NewByteArrayOp _)   = True
1641
1642 primOpNeedsWrapper IntegerAddOp         = True
1643 primOpNeedsWrapper IntegerSubOp         = True
1644 primOpNeedsWrapper IntegerMulOp         = True
1645 primOpNeedsWrapper IntegerQuotRemOp     = True
1646 primOpNeedsWrapper IntegerDivModOp      = True
1647 primOpNeedsWrapper IntegerNegOp         = True
1648 primOpNeedsWrapper IntegerCmpOp         = True
1649 primOpNeedsWrapper Integer2IntOp        = True
1650 primOpNeedsWrapper Int2IntegerOp        = True
1651 primOpNeedsWrapper Word2IntegerOp       = True
1652 primOpNeedsWrapper Addr2IntegerOp       = True
1653
1654 primOpNeedsWrapper FloatExpOp           = True
1655 primOpNeedsWrapper FloatLogOp           = True
1656 primOpNeedsWrapper FloatSqrtOp          = True
1657 primOpNeedsWrapper FloatSinOp           = True
1658 primOpNeedsWrapper FloatCosOp           = True
1659 primOpNeedsWrapper FloatTanOp           = True
1660 primOpNeedsWrapper FloatAsinOp          = True
1661 primOpNeedsWrapper FloatAcosOp          = True
1662 primOpNeedsWrapper FloatAtanOp          = True
1663 primOpNeedsWrapper FloatSinhOp          = True
1664 primOpNeedsWrapper FloatCoshOp          = True
1665 primOpNeedsWrapper FloatTanhOp          = True
1666 primOpNeedsWrapper FloatPowerOp         = True
1667 primOpNeedsWrapper FloatEncodeOp        = True
1668 primOpNeedsWrapper FloatDecodeOp        = True
1669
1670 primOpNeedsWrapper DoubleExpOp          = True
1671 primOpNeedsWrapper DoubleLogOp          = True
1672 primOpNeedsWrapper DoubleSqrtOp         = True
1673 primOpNeedsWrapper DoubleSinOp          = True
1674 primOpNeedsWrapper DoubleCosOp          = True
1675 primOpNeedsWrapper DoubleTanOp          = True
1676 primOpNeedsWrapper DoubleAsinOp         = True
1677 primOpNeedsWrapper DoubleAcosOp         = True
1678 primOpNeedsWrapper DoubleAtanOp         = True
1679 primOpNeedsWrapper DoubleSinhOp         = True
1680 primOpNeedsWrapper DoubleCoshOp         = True
1681 primOpNeedsWrapper DoubleTanhOp         = True
1682 primOpNeedsWrapper DoublePowerOp        = True
1683 primOpNeedsWrapper DoubleEncodeOp       = True
1684 primOpNeedsWrapper DoubleDecodeOp       = True
1685
1686 primOpNeedsWrapper MakeForeignObjOp     = True
1687 primOpNeedsWrapper WriteForeignObjOp    = True
1688 primOpNeedsWrapper MakeStablePtrOp      = True
1689 primOpNeedsWrapper DeRefStablePtrOp     = True
1690
1691 primOpNeedsWrapper TakeMVarOp           = True
1692 primOpNeedsWrapper PutMVarOp            = True
1693 primOpNeedsWrapper ReadIVarOp           = True
1694
1695 primOpNeedsWrapper DelayOp              = True
1696 primOpNeedsWrapper WaitReadOp           = True
1697 primOpNeedsWrapper WaitWriteOp          = True
1698
1699 primOpNeedsWrapper other_op             = False
1700 \end{code}
1701
1702 \begin{code}
1703 primOp_str op
1704   = case (primOpInfo op) of
1705       Dyadic     str _         -> str
1706       Monadic    str _         -> str
1707       Compare    str _         -> str
1708       Coercing   str _ _       -> str
1709       PrimResult str _ _ _ _ _ -> str
1710       AlgResult  str _ _ _ _   -> str
1711 \end{code}
1712
1713 @primOpType@ duplicates some work of @primOpId@, but since we
1714 grab types pretty often...
1715 \begin{code}
1716 primOpType :: PrimOp -> Type
1717
1718 primOpType op
1719   = case (primOpInfo op) of
1720       Dyadic str ty ->      dyadic_fun_ty ty
1721       Monadic str ty ->     monadic_fun_ty ty
1722       Compare str ty ->     compare_fun_ty ty
1723       Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1724
1725       PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1726         mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1727
1728       AlgResult str tyvars arg_tys tycon res_tys ->
1729         mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1730 \end{code}
1731
1732 \begin{code}
1733 data PrimOpResultInfo
1734   = ReturnsPrim     PrimRep
1735   | ReturnsAlg      TyCon
1736
1737 -- ToDo: Deal with specialised PrimOps
1738 --       Will need to return specialised tycon and data constructors
1739
1740 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1741
1742 getPrimOpResultInfo op
1743   = case (primOpInfo op) of
1744       Dyadic  _ ty               -> ReturnsPrim (typePrimRep ty)
1745       Monadic _ ty               -> ReturnsPrim (typePrimRep ty)
1746       Compare _ ty               -> ReturnsAlg  boolTyCon
1747       Coercing  _ _ ty           -> ReturnsPrim (typePrimRep ty)
1748       PrimResult _ _ _ _ kind _  -> ReturnsPrim kind
1749       AlgResult _ _ _ tycon _    -> ReturnsAlg  tycon
1750
1751 isCompareOp :: PrimOp -> Bool
1752
1753 isCompareOp op
1754   = case primOpInfo op of
1755       Compare _ _ -> True
1756       _           -> False
1757 \end{code}
1758
1759 The commutable ops are those for which we will try to move constants
1760 to the right hand side for strength reduction.
1761
1762 \begin{code}
1763 commutableOp :: PrimOp -> Bool
1764
1765 commutableOp CharEqOp     = True
1766 commutableOp CharNeOp     = True
1767 commutableOp IntAddOp     = True
1768 commutableOp IntMulOp     = True
1769 commutableOp AndOp        = True
1770 commutableOp OrOp         = True
1771 commutableOp XorOp        = True
1772 commutableOp IntEqOp      = True
1773 commutableOp IntNeOp      = True
1774 commutableOp IntegerAddOp = True
1775 commutableOp IntegerMulOp = True
1776 commutableOp FloatAddOp   = True
1777 commutableOp FloatMulOp   = True
1778 commutableOp FloatEqOp    = True
1779 commutableOp FloatNeOp    = True
1780 commutableOp DoubleAddOp  = True
1781 commutableOp DoubleMulOp  = True
1782 commutableOp DoubleEqOp   = True
1783 commutableOp DoubleNeOp   = True
1784 commutableOp _            = False
1785 \end{code}
1786
1787 Utils:
1788 \begin{code}
1789 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
1790 monadic_fun_ty ty = mkFunTy  ty ty
1791 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1792 \end{code}
1793
1794 Output stuff:
1795 \begin{code}
1796 pprPrimOp  :: PprStyle -> PrimOp -> Doc
1797 showPrimOp :: PprStyle -> PrimOp -> String
1798
1799 showPrimOp sty op = render (pprPrimOp sty op)
1800
1801 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1802   = let
1803         before
1804           = if is_casm then
1805                if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1806             else
1807                if may_gc then "_ccall_GC_ " else "_ccall_ "
1808
1809         after
1810           = if is_casm then text "''" else empty
1811
1812         pp_tys
1813           = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
1814     in
1815     hcat [text before, ptext fun, after, space, brackets pp_tys]
1816
1817 pprPrimOp sty other_op
1818   | codeStyle sty       -- For C just print the primop itself
1819   = identToC str
1820
1821   | ifaceStyle sty      -- For interfaces Print it qualified with GHC.
1822   = ptext SLIT("GHC.") <> ptext str
1823
1824   | otherwise           -- Unqualified is good enough
1825   = ptext str
1826   where
1827     str = primOp_str other_op
1828
1829
1830
1831 instance Outputable PrimOp where
1832     ppr sty op = pprPrimOp sty op
1833 \end{code}