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