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