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 NameTypes        ( mkPreludeCoreName, FullName, ShortName )
  41 import PprStyle         ( codeStyle )
  42 import PprType          ( pprParendGenType, GenTyVar{-instance Outputable-} )
  43 import Pretty
  44 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  45 import TyCon            ( TyCon{-instances-} )
  46 import Type             ( getAppDataTyCon, maybeAppDataTyCon,
  47                           mkForAllTys, mkFunTys, applyTyCon, typePrimRep
  48                         )
  49 import TyVar            ( alphaTyVar, betaTyVar, GenTyVar{-instance Eq-} )
  50 import Unique           ( Unique{-instance Eq-} )
  51 import Util             ( panic#, assoc, panic{-ToDo:rm-} )
  52 \end{code}
  53
  54 %************************************************************************
  55 %*                                                                      *
  56 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
  57 %*                                                                      *
  58 %************************************************************************
  59
  60 These are in \tr{state-interface.verb} order.
  61
  62 \begin{code}
  63 data PrimOp
  64     -- dig the FORTRAN/C influence on the names...
  65
  66     -- comparisons:
  67
  68     = CharGtOp   | CharGeOp   | CharEqOp   | CharNeOp   | CharLtOp   | CharLeOp
  69     | IntGtOp    | IntGeOp    | IntEqOp    | IntNeOp    | IntLtOp    | IntLeOp
  70     | WordGtOp   | WordGeOp   | WordEqOp   | WordNeOp   | WordLtOp   | WordLeOp
  71     | AddrGtOp   | AddrGeOp   | AddrEqOp   | AddrNeOp   | AddrLtOp   | AddrLeOp
  72     | FloatGtOp  | FloatGeOp  | FloatEqOp  | FloatNeOp  | FloatLtOp  | FloatLeOp
  73     | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
  74
  75     -- Char#-related ops:
  76     | OrdOp | ChrOp
  77
  78     -- Int#-related ops:
  79     -- IntAbsOp unused?? ADR
  80     | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
  81     | IntRemOp | IntNegOp | IntAbsOp
  82
  83     -- Word#-related ops:
  84     | AndOp  | OrOp   | NotOp
  85     | SllOp  | SraOp  | SrlOp  -- shift {left,right} {arithmetic,logical}
  86     | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
  87     | Int2WordOp | Word2IntOp -- casts
  88
  89     -- Addr#-related ops:
  90     | Int2AddrOp | Addr2IntOp -- casts
  91
  92     -- Float#-related ops:
  93     | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
  94     | Float2IntOp | Int2FloatOp
  95
  96     | FloatExpOp   | FloatLogOp   | FloatSqrtOp
  97     | FloatSinOp   | FloatCosOp   | FloatTanOp
  98     | FloatAsinOp  | FloatAcosOp  | FloatAtanOp
  99     | FloatSinhOp  | FloatCoshOp  | FloatTanhOp
 100     -- not all machines have these available conveniently:
 101     -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
 102     | FloatPowerOp -- ** op
 103
 104     -- Double#-related ops:
 105     | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
 106     | Double2IntOp | Int2DoubleOp
 107     | Double2FloatOp | Float2DoubleOp
 108
 109     | DoubleExpOp   | DoubleLogOp   | DoubleSqrtOp
 110     | DoubleSinOp   | DoubleCosOp   | DoubleTanOp
 111     | DoubleAsinOp  | DoubleAcosOp  | DoubleAtanOp
 112     | DoubleSinhOp  | DoubleCoshOp  | DoubleTanhOp
 113     -- not all machines have these available conveniently:
 114     -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
 115     | DoublePowerOp -- ** op
 116
 117     -- Integer (and related...) ops:
 118     -- slightly weird -- to match GMP package.
 119     | IntegerAddOp | IntegerSubOp | IntegerMulOp
 120     | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
 121
 122     | IntegerCmpOp
 123
 124     | Integer2IntOp  | Int2IntegerOp
 125     | Word2IntegerOp
 126     | Addr2IntegerOp -- "Addr" is *always* a literal string
 127     -- ?? gcd, etc?
 128
 129     | FloatEncodeOp  | FloatDecodeOp
 130     | DoubleEncodeOp | DoubleDecodeOp
 131
 132     -- primitive ops for primitive arrays
 133
 134     | NewArrayOp
 135     | NewByteArrayOp PrimRep
 136
 137     | SameMutableArrayOp
 138     | SameMutableByteArrayOp
 139
 140     | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
 141
 142     | ReadByteArrayOp   PrimRep
 143     | WriteByteArrayOp  PrimRep
 144     | IndexByteArrayOp  PrimRep
 145     | IndexOffAddrOp    PrimRep
 146         -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
 147         -- This is just a cheesy encoding of a bunch of ops.
 148         -- Note that MallocPtrRep is not included -- the only way of
 149         -- creating a MallocPtr is with a ccall or casm.
 150
 151     | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
 152
 153     | NewSynchVarOp -- for MVars and IVars
 154     | TakeMVarOp | PutMVarOp
 155     | ReadIVarOp | WriteIVarOp
 156
 157     | MakeStablePtrOp | DeRefStablePtrOp
 158 \end{code}
 159
 160 A special ``trap-door'' to use in making calls direct to C functions:
 161 \begin{code}
 162     | CCallOp   FAST_STRING     -- An "unboxed" ccall# to this named function
 163                 Bool            -- True <=> really a "casm"
 164                 Bool            -- True <=> might invoke Haskell GC
 165                 [Type]  -- Unboxed argument; the state-token
 166                                 -- argument will have been put *first*
 167                 Type            -- Return type; one of the "StateAnd<blah>#" types
 168
 169     -- (... to be continued ... )
 170 \end{code}
 171
 172 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
 173 (See @primOpInfo@ for details.)
 174
 175 Note: that first arg and part of the result should be the system state
 176 token (which we carry around to fool over-zealous optimisers) but
 177 which isn't actually passed.
 178
 179 For example, we represent
 180 \begin{pseudocode}
 181 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
 182 \end{pseudocode}
 183 by
 184 \begin{pseudocode}
 185 Case
 186   ( Prim
 187       (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
 188        -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
 189       []
 190       [w#, sp# i#]
 191   )
 192   (AlgAlts [ ( FloatPrimAndIoWorld,
 193                  [f#, w#],
 194                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
 195                ) ]
 196              NoDefault
 197   )
 198 \end{pseudocode}
 199
 200 Nota Bene: there are some people who find the empty list of types in
 201 the @Prim@ somewhat puzzling and would represent the above by
 202 \begin{pseudocode}
 203 Case
 204   ( Prim
 205       (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
 206        -- :: /\ alpha1, alpha2 alpha3, alpha4.
 207        --       alpha1 -> alpha2 -> alpha3 -> alpha4
 208       [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
 209       [w#, sp# i#]
 210   )
 211   (AlgAlts [ ( FloatPrimAndIoWorld,
 212                  [f#, w#],
 213                  Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
 214                ) ]
 215              NoDefault
 216   )
 217 \end{pseudocode}
 218
 219 But, this is a completely different way of using @CCallOp@.  The most
 220 major changes required if we switch to this are in @primOpInfo@, and
 221 the desugarer. The major difficulty is in moving the HeapRequirement
 222 stuff somewhere appropriate.  (The advantage is that we could simplify
 223 @CCallOp@ and record just the number of arguments with corresponding
 224 simplifications in reading pragma unfoldings, the simplifier,
 225 instantiation (etc) of core expressions, ... .  Maybe we should think
 226 about using it this way?? ADR)
 227
 228 \begin{code}
 229     -- (... continued from above ... )
 230
 231     -- one to support "errorIO" (and, thereby, "error")
 232     | ErrorIOPrimOp
 233
 234     -- Operation to test two closure addresses for equality (yes really!)
 235     -- BLAME ALASTAIR REID FOR THIS!  THE REST OF US ARE INNOCENT!
 236     | ReallyUnsafePtrEqualityOp
 237
 238     -- three for parallel stuff
 239     | SeqOp
 240     | ParOp
 241     | ForkOp
 242
 243     -- two for concurrency
 244     | DelayOp
 245     | WaitOp
 246
 247 #ifdef GRAN
 248     | ParGlobalOp       -- named global par
 249     | ParLocalOp        -- named local par
 250     | ParAtOp           -- specifies destination of local par
 251     | ParAtForNowOp     -- specifies initial destination of global par
 252     | CopyableOp        -- marks copyable code
 253     | NoFollowOp        -- marks non-followup expression
 254 #endif {-GRAN-}
 255 \end{code}
 256
 257 Deriving Ix is what we really want! ToDo
 258 (Chk around before deleting...)
 259 \begin{code}
 260 tagOf_PrimOp CharGtOp                   = (ILIT(1) :: FAST_INT)
 261 tagOf_PrimOp CharGeOp                   = ILIT(  2)
 262 tagOf_PrimOp CharEqOp                   = ILIT(  3)
 263 tagOf_PrimOp CharNeOp                   = ILIT(  4)
 264 tagOf_PrimOp CharLtOp                   = ILIT(  5)
 265 tagOf_PrimOp CharLeOp                   = ILIT(  6)
 266 tagOf_PrimOp IntGtOp                    = ILIT(  7)
 267 tagOf_PrimOp IntGeOp                    = ILIT(  8)
 268 tagOf_PrimOp IntEqOp                    = ILIT(  9)
 269 tagOf_PrimOp IntNeOp                    = ILIT( 10)
 270 tagOf_PrimOp IntLtOp                    = ILIT( 11)
 271 tagOf_PrimOp IntLeOp                    = ILIT( 12)
 272 tagOf_PrimOp WordGtOp                   = ILIT( 13)
 273 tagOf_PrimOp WordGeOp                   = ILIT( 14)
 274 tagOf_PrimOp WordEqOp                   = ILIT( 15)
 275 tagOf_PrimOp WordNeOp                   = ILIT( 16)
 276 tagOf_PrimOp WordLtOp                   = ILIT( 17)
 277 tagOf_PrimOp WordLeOp                   = ILIT( 18)
 278 tagOf_PrimOp AddrGtOp                   = ILIT( 19)
 279 tagOf_PrimOp AddrGeOp                   = ILIT( 20)
 280 tagOf_PrimOp AddrEqOp                   = ILIT( 21)
 281 tagOf_PrimOp AddrNeOp                   = ILIT( 22)
 282 tagOf_PrimOp AddrLtOp                   = ILIT( 23)
 283 tagOf_PrimOp AddrLeOp                   = ILIT( 24)
 284 tagOf_PrimOp FloatGtOp                  = ILIT( 25)
 285 tagOf_PrimOp FloatGeOp                  = ILIT( 26)
 286 tagOf_PrimOp FloatEqOp                  = ILIT( 27)
 287 tagOf_PrimOp FloatNeOp                  = ILIT( 28)
 288 tagOf_PrimOp FloatLtOp                  = ILIT( 29)
 289 tagOf_PrimOp FloatLeOp                  = ILIT( 30)
 290 tagOf_PrimOp DoubleGtOp                 = ILIT( 31)
 291 tagOf_PrimOp DoubleGeOp                 = ILIT( 32)
 292 tagOf_PrimOp DoubleEqOp                 = ILIT( 33)
 293 tagOf_PrimOp DoubleNeOp                 = ILIT( 34)
 294 tagOf_PrimOp DoubleLtOp                 = ILIT( 35)
 295 tagOf_PrimOp DoubleLeOp                 = ILIT( 36)
 296 tagOf_PrimOp OrdOp                      = ILIT( 37)
 297 tagOf_PrimOp ChrOp                      = ILIT( 38)
 298 tagOf_PrimOp IntAddOp                   = ILIT( 39)
 299 tagOf_PrimOp IntSubOp                   = ILIT( 40)
 300 tagOf_PrimOp IntMulOp                   = ILIT( 41)
 301 tagOf_PrimOp IntQuotOp                  = ILIT( 42)
 302 tagOf_PrimOp IntRemOp                   = ILIT( 44)
 303 tagOf_PrimOp IntNegOp                   = ILIT( 45)
 304 tagOf_PrimOp IntAbsOp                   = ILIT( 46)
 305 tagOf_PrimOp AndOp                      = ILIT( 47)
 306 tagOf_PrimOp OrOp                       = ILIT( 48)
 307 tagOf_PrimOp NotOp                      = ILIT( 49)
 308 tagOf_PrimOp SllOp                      = ILIT( 50)
 309 tagOf_PrimOp SraOp                      = ILIT( 51)
 310 tagOf_PrimOp SrlOp                      = ILIT( 52)
 311 tagOf_PrimOp ISllOp                     = ILIT( 53)
 312 tagOf_PrimOp ISraOp                     = ILIT( 54)
 313 tagOf_PrimOp ISrlOp                     = ILIT( 55)
 314 tagOf_PrimOp Int2WordOp                 = ILIT( 56)
 315 tagOf_PrimOp Word2IntOp                 = ILIT( 57)
 316 tagOf_PrimOp Int2AddrOp                 = ILIT( 58)
 317 tagOf_PrimOp Addr2IntOp                 = ILIT( 59)
 318 tagOf_PrimOp FloatAddOp                 = ILIT( 60)
 319 tagOf_PrimOp FloatSubOp                 = ILIT( 61)
 320 tagOf_PrimOp FloatMulOp                 = ILIT( 62)
 321 tagOf_PrimOp FloatDivOp                 = ILIT( 63)
 322 tagOf_PrimOp FloatNegOp                 = ILIT( 64)
 323 tagOf_PrimOp Float2IntOp                = ILIT( 65)
 324 tagOf_PrimOp Int2FloatOp                = ILIT( 66)
 325 tagOf_PrimOp FloatExpOp                 = ILIT( 67)
 326 tagOf_PrimOp FloatLogOp                 = ILIT( 68)
 327 tagOf_PrimOp FloatSqrtOp                = ILIT( 69)
 328 tagOf_PrimOp FloatSinOp                 = ILIT( 70)
 329 tagOf_PrimOp FloatCosOp                 = ILIT( 71)
 330 tagOf_PrimOp FloatTanOp                 = ILIT( 72)
 331 tagOf_PrimOp FloatAsinOp                = ILIT( 73)
 332 tagOf_PrimOp FloatAcosOp                = ILIT( 74)
 333 tagOf_PrimOp FloatAtanOp                = ILIT( 75)
 334 tagOf_PrimOp FloatSinhOp                = ILIT( 76)
 335 tagOf_PrimOp FloatCoshOp                = ILIT( 77)
 336 tagOf_PrimOp FloatTanhOp                = ILIT( 78)
 337 tagOf_PrimOp FloatPowerOp               = ILIT( 79)
 338 tagOf_PrimOp DoubleAddOp                = ILIT( 80)
 339 tagOf_PrimOp DoubleSubOp                = ILIT( 81)
 340 tagOf_PrimOp DoubleMulOp                = ILIT( 82)
 341 tagOf_PrimOp DoubleDivOp                = ILIT( 83)
 342 tagOf_PrimOp DoubleNegOp                = ILIT( 84)
 343 tagOf_PrimOp Double2IntOp               = ILIT( 85)
 344 tagOf_PrimOp Int2DoubleOp               = ILIT( 86)
 345 tagOf_PrimOp Double2FloatOp             = ILIT( 87)
 346 tagOf_PrimOp Float2DoubleOp             = ILIT( 88)
 347 tagOf_PrimOp DoubleExpOp                = ILIT( 89)
 348 tagOf_PrimOp DoubleLogOp                = ILIT( 90)
 349 tagOf_PrimOp DoubleSqrtOp               = ILIT( 91)
 350 tagOf_PrimOp DoubleSinOp                = ILIT( 92)
 351 tagOf_PrimOp DoubleCosOp                = ILIT( 93)
 352 tagOf_PrimOp DoubleTanOp                = ILIT( 94)
 353 tagOf_PrimOp DoubleAsinOp               = ILIT( 95)
 354 tagOf_PrimOp DoubleAcosOp               = ILIT( 96)
 355 tagOf_PrimOp DoubleAtanOp               = ILIT( 97)
 356 tagOf_PrimOp DoubleSinhOp               = ILIT( 98)
 357 tagOf_PrimOp DoubleCoshOp               = ILIT( 99)
 358 tagOf_PrimOp DoubleTanhOp               = ILIT(100)
 359 tagOf_PrimOp DoublePowerOp              = ILIT(101)
 360 tagOf_PrimOp IntegerAddOp               = ILIT(102)
 361 tagOf_PrimOp IntegerSubOp               = ILIT(103)
 362 tagOf_PrimOp IntegerMulOp               = ILIT(104)
 363 tagOf_PrimOp IntegerQuotRemOp           = ILIT(105)
 364 tagOf_PrimOp IntegerDivModOp            = ILIT(106)
 365 tagOf_PrimOp IntegerNegOp               = ILIT(107)
 366 tagOf_PrimOp IntegerCmpOp               = ILIT(108)
 367 tagOf_PrimOp Integer2IntOp              = ILIT(109)
 368 tagOf_PrimOp Int2IntegerOp              = ILIT(110)
 369 tagOf_PrimOp Word2IntegerOp             = ILIT(111)
 370 tagOf_PrimOp Addr2IntegerOp             = ILIT(112)
 371 tagOf_PrimOp FloatEncodeOp              = ILIT(113)
 372 tagOf_PrimOp FloatDecodeOp              = ILIT(114)
 373 tagOf_PrimOp DoubleEncodeOp             = ILIT(115)
 374 tagOf_PrimOp DoubleDecodeOp             = ILIT(116)
 375 tagOf_PrimOp NewArrayOp                 = ILIT(117)
 376 tagOf_PrimOp (NewByteArrayOp CharRep)   = ILIT(118)
 377 tagOf_PrimOp (NewByteArrayOp IntRep)    = ILIT(119)
 378 tagOf_PrimOp (NewByteArrayOp AddrRep)   = ILIT(120)
 379 tagOf_PrimOp (NewByteArrayOp FloatRep)  = ILIT(121)
 380 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
 381 tagOf_PrimOp SameMutableArrayOp         = ILIT(123)
 382 tagOf_PrimOp SameMutableByteArrayOp     = ILIT(124)
 383 tagOf_PrimOp ReadArrayOp                = ILIT(125)
 384 tagOf_PrimOp WriteArrayOp               = ILIT(126)
 385 tagOf_PrimOp IndexArrayOp               = ILIT(127)
 386 tagOf_PrimOp (ReadByteArrayOp CharRep)      = ILIT(128)
 387 tagOf_PrimOp (ReadByteArrayOp IntRep)       = ILIT(129)
 388 tagOf_PrimOp (ReadByteArrayOp AddrRep)      = ILIT(130)
 389 tagOf_PrimOp (ReadByteArrayOp FloatRep)    = ILIT(131)
 390 tagOf_PrimOp (ReadByteArrayOp DoubleRep)   = ILIT(132)
 391 tagOf_PrimOp (WriteByteArrayOp CharRep)    = ILIT(133)
 392 tagOf_PrimOp (WriteByteArrayOp IntRep)      = ILIT(134)
 393 tagOf_PrimOp (WriteByteArrayOp AddrRep)    = ILIT(135)
 394 tagOf_PrimOp (WriteByteArrayOp FloatRep)   = ILIT(136)
 395 tagOf_PrimOp (WriteByteArrayOp DoubleRep)  = ILIT(137)
 396 tagOf_PrimOp (IndexByteArrayOp CharRep)    = ILIT(138)
 397 tagOf_PrimOp (IndexByteArrayOp IntRep)      = ILIT(139)
 398 tagOf_PrimOp (IndexByteArrayOp AddrRep)    = ILIT(140)
 399 tagOf_PrimOp (IndexByteArrayOp FloatRep)   = ILIT(141)
 400 tagOf_PrimOp (IndexByteArrayOp DoubleRep)  = ILIT(142)
 401 tagOf_PrimOp (IndexOffAddrOp CharRep)       = ILIT(143)
 402 tagOf_PrimOp (IndexOffAddrOp IntRep)        = ILIT(144)
 403 tagOf_PrimOp (IndexOffAddrOp AddrRep)       = ILIT(145)
 404 tagOf_PrimOp (IndexOffAddrOp FloatRep)      = ILIT(146)
 405 tagOf_PrimOp (IndexOffAddrOp DoubleRep)    = ILIT(147)
 406 tagOf_PrimOp UnsafeFreezeArrayOp            = ILIT(148)
 407 tagOf_PrimOp UnsafeFreezeByteArrayOp        = ILIT(149)
 408 tagOf_PrimOp NewSynchVarOp                  = ILIT(150)
 409 tagOf_PrimOp TakeMVarOp                     = ILIT(151)
 410 tagOf_PrimOp PutMVarOp                      = ILIT(152)
 411 tagOf_PrimOp ReadIVarOp                     = ILIT(153)
 412 tagOf_PrimOp WriteIVarOp                    = ILIT(154)
 413 tagOf_PrimOp MakeStablePtrOp                = ILIT(155)
 414 tagOf_PrimOp DeRefStablePtrOp               = ILIT(156)
 415 tagOf_PrimOp (CCallOp _ _ _ _ _)            = ILIT(157)
 416 tagOf_PrimOp ErrorIOPrimOp                  = ILIT(158)
 417 tagOf_PrimOp ReallyUnsafePtrEqualityOp      = ILIT(159)
 418 tagOf_PrimOp SeqOp                          = ILIT(160)
 419 tagOf_PrimOp ParOp                          = ILIT(161)
 420 tagOf_PrimOp ForkOp                         = ILIT(162)
 421 tagOf_PrimOp DelayOp                        = ILIT(163)
 422 tagOf_PrimOp WaitOp                         = ILIT(164)
 423
 424 #ifdef GRAN
 425 tagOf_PrimOp ParGlobalOp                    = ILIT(165)
 426 tagOf_PrimOp ParLocalOp                     = ILIT(166)
 427 tagOf_PrimOp ParAtOp                        = ILIT(167)
 428 tagOf_PrimOp ParAtForNowOp                  = ILIT(168)
 429 tagOf_PrimOp CopyableOp                     = ILIT(169)
 430 tagOf_PrimOp NoFollowOp                     = ILIT(170)
 431 #endif {-GRAN-}
 432
 433 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
 434
 435 instance Eq PrimOp where
 436     op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
 437 \end{code}
 438
 439 An @Enum@-derived list would be better; meanwhile... (ToDo)
 440 \begin{code}
 441 allThePrimOps
 442   = [   CharGtOp,
 443         CharGeOp,
 444         CharEqOp,
 445         CharNeOp,
 446         CharLtOp,
 447         CharLeOp,
 448         IntGtOp,
 449         IntGeOp,
 450         IntEqOp,
 451         IntNeOp,
 452         IntLtOp,
 453         IntLeOp,
 454         WordGtOp,
 455         WordGeOp,
 456         WordEqOp,
 457         WordNeOp,
 458         WordLtOp,
 459         WordLeOp,
 460         AddrGtOp,
 461         AddrGeOp,
 462         AddrEqOp,
 463         AddrNeOp,
 464         AddrLtOp,
 465         AddrLeOp,
 466         FloatGtOp,
 467         FloatGeOp,
 468         FloatEqOp,
 469         FloatNeOp,
 470         FloatLtOp,
 471         FloatLeOp,
 472         DoubleGtOp,
 473         DoubleGeOp,
 474         DoubleEqOp,
 475         DoubleNeOp,
 476         DoubleLtOp,
 477         DoubleLeOp,
 478         OrdOp,
 479         ChrOp,
 480         IntAddOp,
 481         IntSubOp,
 482         IntMulOp,
 483         IntQuotOp,
 484         IntRemOp,
 485         IntNegOp,
 486         AndOp,
 487         OrOp,
 488         NotOp,
 489         SllOp,
 490         SraOp,
 491         SrlOp,
 492         ISllOp,
 493         ISraOp,
 494         ISrlOp,
 495         Int2WordOp,
 496         Word2IntOp,
 497         Int2AddrOp,
 498         Addr2IntOp,
 499         FloatAddOp,
 500         FloatSubOp,
 501         FloatMulOp,
 502         FloatDivOp,
 503         FloatNegOp,
 504         Float2IntOp,
 505         Int2FloatOp,
 506         FloatExpOp,
 507         FloatLogOp,
 508         FloatSqrtOp,
 509         FloatSinOp,
 510         FloatCosOp,
 511         FloatTanOp,
 512         FloatAsinOp,
 513         FloatAcosOp,
 514         FloatAtanOp,
 515         FloatSinhOp,
 516         FloatCoshOp,
 517         FloatTanhOp,
 518         FloatPowerOp,
 519         DoubleAddOp,
 520         DoubleSubOp,
 521         DoubleMulOp,
 522         DoubleDivOp,
 523         DoubleNegOp,
 524         Double2IntOp,
 525         Int2DoubleOp,
 526         Double2FloatOp,
 527         Float2DoubleOp,
 528         DoubleExpOp,
 529         DoubleLogOp,
 530         DoubleSqrtOp,
 531         DoubleSinOp,
 532         DoubleCosOp,
 533         DoubleTanOp,
 534         DoubleAsinOp,
 535         DoubleAcosOp,
 536         DoubleAtanOp,
 537         DoubleSinhOp,
 538         DoubleCoshOp,
 539         DoubleTanhOp,
 540         DoublePowerOp,
 541         IntegerAddOp,
 542         IntegerSubOp,
 543         IntegerMulOp,
 544         IntegerQuotRemOp,
 545         IntegerDivModOp,
 546         IntegerNegOp,
 547         IntegerCmpOp,
 548         Integer2IntOp,
 549         Int2IntegerOp,
 550         Word2IntegerOp,
 551         Addr2IntegerOp,
 552         FloatEncodeOp,
 553         FloatDecodeOp,
 554         DoubleEncodeOp,
 555         DoubleDecodeOp,
 556         NewArrayOp,
 557         NewByteArrayOp CharRep,
 558         NewByteArrayOp IntRep,
 559         NewByteArrayOp AddrRep,
 560         NewByteArrayOp FloatRep,
 561         NewByteArrayOp DoubleRep,
 562         SameMutableArrayOp,
 563         SameMutableByteArrayOp,
 564         ReadArrayOp,
 565         WriteArrayOp,
 566         IndexArrayOp,
 567         ReadByteArrayOp CharRep,
 568         ReadByteArrayOp IntRep,
 569         ReadByteArrayOp AddrRep,
 570         ReadByteArrayOp FloatRep,
 571         ReadByteArrayOp DoubleRep,
 572         WriteByteArrayOp CharRep,
 573         WriteByteArrayOp IntRep,
 574         WriteByteArrayOp AddrRep,
 575         WriteByteArrayOp FloatRep,
 576         WriteByteArrayOp DoubleRep,
 577         IndexByteArrayOp CharRep,
 578         IndexByteArrayOp IntRep,
 579         IndexByteArrayOp AddrRep,
 580         IndexByteArrayOp FloatRep,
 581         IndexByteArrayOp DoubleRep,
 582         IndexOffAddrOp CharRep,
 583         IndexOffAddrOp IntRep,
 584         IndexOffAddrOp AddrRep,
 585         IndexOffAddrOp FloatRep,
 586         IndexOffAddrOp DoubleRep,
 587         UnsafeFreezeArrayOp,
 588         UnsafeFreezeByteArrayOp,
 589         NewSynchVarOp,
 590         ReadArrayOp,
 591         TakeMVarOp,
 592         PutMVarOp,
 593         ReadIVarOp,
 594         WriteIVarOp,
 595         MakeStablePtrOp,
 596         DeRefStablePtrOp,
 597         ReallyUnsafePtrEqualityOp,
 598         ErrorIOPrimOp,
 599 #ifdef GRAN
 600         ParGlobalOp,
 601         ParLocalOp,
 602 #endif {-GRAN-}
 603         SeqOp,
 604         ParOp,
 605         ForkOp,
 606         DelayOp,
 607         WaitOp
 608     ]
 609 \end{code}
 610
 611 %************************************************************************
 612 %*                                                                      *
 613 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
 614 %*                                                                      *
 615 %************************************************************************
 616
 617 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
 618 refer to the primitive operation.  The conventional \tr{#}-for-
 619 unboxed ops is added on later.
 620
 621 The reason for the funny characters in the names is so we do not
 622 interfere with the programmer's Haskell name spaces.
 623
 624 We use @PrimKinds@ for the ``type'' information, because they're
 625 (slightly) more convenient to use than @TyCons@.
 626 \begin{code}
 627 data PrimOpInfo
 628   = Dyadic      FAST_STRING     -- string :: T -> T -> T
 629                 Type
 630   | Monadic     FAST_STRING     -- string :: T -> T
 631                 Type
 632   | Compare     FAST_STRING     -- string :: T -> T -> Bool
 633                 Type
 634   | Coerce      FAST_STRING     -- string :: T1 -> T2
 635                 Type
 636                 Type
 637
 638   | PrimResult  FAST_STRING
 639                 [TyVar] [Type] TyCon PrimRep [Type]
 640                 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
 641                 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
 642                 -- D# is a primitive type constructor.
 643                 -- (the kind is the same info as D#, in another convenient form)
 644
 645   | AlgResult   FAST_STRING
 646                 [TyVar] [Type] TyCon [Type]
 647                 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
 648                 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
 649
 650 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
 651 \end{code}
 652
 653 Utility bits:
 654 \begin{code}
 655 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
 656 two_Integer_tys
 657   = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
 658      intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
 659 an_Integer_and_Int_tys
 660   = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
 661      intPrimTy]
 662
 663 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
 664
 665 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
 666
 667 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
 668
 669 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
 670 \end{code}
 671
 672 @primOpInfo@ gives all essential information (from which everything
 673 else, notably a type, can be constructed) for each @PrimOp@.
 674
 675 \begin{code}
 676 primOpInfo :: PrimOp -> PrimOpInfo
 677 \end{code}
 678
 679 There's plenty of this stuff!
 680
 681 %************************************************************************
 682 %*                                                                      *
 683 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
 684 %*                                                                      *
 685 %************************************************************************
 686
 687 \begin{code}
 688 primOpInfo CharGtOp   = Compare SLIT("gtChar#")   charPrimTy
 689 primOpInfo CharGeOp   = Compare SLIT("geChar#")   charPrimTy
 690 primOpInfo CharEqOp   = Compare SLIT("eqChar#")   charPrimTy
 691 primOpInfo CharNeOp   = Compare SLIT("neChar#")   charPrimTy
 692 primOpInfo CharLtOp   = Compare SLIT("ltChar#")   charPrimTy
 693 primOpInfo CharLeOp   = Compare SLIT("leChar#")   charPrimTy
 694
 695 primOpInfo IntGtOp    = Compare SLIT("gtInt#")     intPrimTy
 696 primOpInfo IntGeOp    = Compare SLIT("geInt#")     intPrimTy
 697 primOpInfo IntEqOp    = Compare SLIT("eqInt#")     intPrimTy
 698 primOpInfo IntNeOp    = Compare SLIT("neInt#")     intPrimTy
 699 primOpInfo IntLtOp    = Compare SLIT("ltInt#")     intPrimTy
 700 primOpInfo IntLeOp    = Compare SLIT("leInt#")     intPrimTy
 701
 702 primOpInfo WordGtOp   = Compare SLIT("gtWord#")   wordPrimTy
 703 primOpInfo WordGeOp   = Compare SLIT("geWord#")   wordPrimTy
 704 primOpInfo WordEqOp   = Compare SLIT("eqWord#")   wordPrimTy
 705 primOpInfo WordNeOp   = Compare SLIT("neWord#")   wordPrimTy
 706 primOpInfo WordLtOp   = Compare SLIT("ltWord#")   wordPrimTy
 707 primOpInfo WordLeOp   = Compare SLIT("leWord#")   wordPrimTy
 708
 709 primOpInfo AddrGtOp   = Compare SLIT("gtAddr#")   addrPrimTy
 710 primOpInfo AddrGeOp   = Compare SLIT("geAddr#")   addrPrimTy
 711 primOpInfo AddrEqOp   = Compare SLIT("eqAddr#")   addrPrimTy
 712 primOpInfo AddrNeOp   = Compare SLIT("neAddr#")   addrPrimTy
 713 primOpInfo AddrLtOp   = Compare SLIT("ltAddr#")   addrPrimTy
 714 primOpInfo AddrLeOp   = Compare SLIT("leAddr#")   addrPrimTy
 715
 716 primOpInfo FloatGtOp  = Compare SLIT("gtFloat#")  floatPrimTy
 717 primOpInfo FloatGeOp  = Compare SLIT("geFloat#")  floatPrimTy
 718 primOpInfo FloatEqOp  = Compare SLIT("eqFloat#")  floatPrimTy
 719 primOpInfo FloatNeOp  = Compare SLIT("neFloat#")  floatPrimTy
 720 primOpInfo FloatLtOp  = Compare SLIT("ltFloat#")  floatPrimTy
 721 primOpInfo FloatLeOp  = Compare SLIT("leFloat#")  floatPrimTy
 722
 723 primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
 724 primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
 725 primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
 726 primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
 727 primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
 728 primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
 729 \end{code}
 730
 731 %************************************************************************
 732 %*                                                                      *
 733 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
 734 %*                                                                      *
 735 %************************************************************************
 736
 737 \begin{code}
 738 primOpInfo OrdOp = Coerce SLIT("ord#") charPrimTy intPrimTy
 739 primOpInfo ChrOp = Coerce SLIT("chr#") intPrimTy charPrimTy
 740 \end{code}
 741
 742 %************************************************************************
 743 %*                                                                      *
 744 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
 745 %*                                                                      *
 746 %************************************************************************
 747
 748 \begin{code}
 749 primOpInfo IntAddOp  = Dyadic SLIT("plusInt#")   intPrimTy
 750 primOpInfo IntSubOp  = Dyadic SLIT("minusInt#") intPrimTy
 751 primOpInfo IntMulOp  = Dyadic SLIT("timesInt#") intPrimTy
 752 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")   intPrimTy
 753 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")    intPrimTy
 754
 755 primOpInfo IntNegOp  = Monadic SLIT("negateInt#") intPrimTy
 756 \end{code}
 757
 758 %************************************************************************
 759 %*                                                                      *
 760 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
 761 %*                                                                      *
 762 %************************************************************************
 763
 764 A @Word#@ is an unsigned @Int#@.
 765
 766 \begin{code}
 767 primOpInfo AndOp    = Dyadic  SLIT("and#")      wordPrimTy
 768 primOpInfo OrOp     = Dyadic  SLIT("or#")       wordPrimTy
 769 primOpInfo NotOp    = Monadic SLIT("not#")      wordPrimTy
 770
 771 primOpInfo SllOp
 772   = PrimResult SLIT("shiftL#")  [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 773 primOpInfo SraOp
 774   = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 775 primOpInfo SrlOp
 776   = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
 777
 778 primOpInfo ISllOp
 779   = PrimResult SLIT("iShiftL#")  [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 780 primOpInfo ISraOp
 781   = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 782 primOpInfo ISrlOp
 783   = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
 784
 785 primOpInfo Int2WordOp = Coerce SLIT("int2Word#") intPrimTy wordPrimTy
 786 primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy
 787 \end{code}
 788
 789 %************************************************************************
 790 %*                                                                      *
 791 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
 792 %*                                                                      *
 793 %************************************************************************
 794
 795 \begin{code}
 796 primOpInfo Int2AddrOp = Coerce SLIT("int2Addr#") intPrimTy addrPrimTy
 797 primOpInfo Addr2IntOp = Coerce SLIT("addr2Int#") addrPrimTy intPrimTy
 798 \end{code}
 799
 800 %************************************************************************
 801 %*                                                                      *
 802 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
 803 %*                                                                      *
 804 %************************************************************************
 805
 806 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
 807 similar).
 808
 809 \begin{code}
 810 primOpInfo FloatAddOp   = Dyadic    SLIT("plusFloat#")     floatPrimTy
 811 primOpInfo FloatSubOp   = Dyadic    SLIT("minusFloat#")   floatPrimTy
 812 primOpInfo FloatMulOp   = Dyadic    SLIT("timesFloat#")   floatPrimTy
 813 primOpInfo FloatDivOp   = Dyadic    SLIT("divideFloat#")  floatPrimTy
 814 primOpInfo FloatNegOp   = Monadic   SLIT("negateFloat#")  floatPrimTy
 815
 816 primOpInfo Float2IntOp  = Coerce SLIT("float2Int#") floatPrimTy intPrimTy
 817 primOpInfo Int2FloatOp  = Coerce SLIT("int2Float#") intPrimTy floatPrimTy
 818
 819 primOpInfo FloatExpOp   = Monadic   SLIT("expFloat#")      floatPrimTy
 820 primOpInfo FloatLogOp   = Monadic   SLIT("logFloat#")      floatPrimTy
 821 primOpInfo FloatSqrtOp  = Monadic   SLIT("sqrtFloat#")     floatPrimTy
 822 primOpInfo FloatSinOp   = Monadic   SLIT("sinFloat#")      floatPrimTy
 823 primOpInfo FloatCosOp   = Monadic   SLIT("cosFloat#")      floatPrimTy
 824 primOpInfo FloatTanOp   = Monadic   SLIT("tanFloat#")      floatPrimTy
 825 primOpInfo FloatAsinOp  = Monadic   SLIT("asinFloat#")     floatPrimTy
 826 primOpInfo FloatAcosOp  = Monadic   SLIT("acosFloat#")     floatPrimTy
 827 primOpInfo FloatAtanOp  = Monadic   SLIT("atanFloat#")     floatPrimTy
 828 primOpInfo FloatSinhOp  = Monadic   SLIT("sinhFloat#")     floatPrimTy
 829 primOpInfo FloatCoshOp  = Monadic   SLIT("coshFloat#")     floatPrimTy
 830 primOpInfo FloatTanhOp  = Monadic   SLIT("tanhFloat#")     floatPrimTy
 831 primOpInfo FloatPowerOp = Dyadic    SLIT("powerFloat#")   floatPrimTy
 832 \end{code}
 833
 834 %************************************************************************
 835 %*                                                                      *
 836 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
 837 %*                                                                      *
 838 %************************************************************************
 839
 840 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
 841 similar).
 842
 843 \begin{code}
 844 primOpInfo DoubleAddOp  = Dyadic    SLIT("plusDouble#")   doublePrimTy
 845 primOpInfo DoubleSubOp  = Dyadic    SLIT("minusDouble#")  doublePrimTy
 846 primOpInfo DoubleMulOp  = Dyadic    SLIT("timesDouble#")  doublePrimTy
 847 primOpInfo DoubleDivOp  = Dyadic    SLIT("divideDouble#") doublePrimTy
 848 primOpInfo DoubleNegOp  = Monadic   SLIT("negateDouble#") doublePrimTy
 849
 850 primOpInfo Double2IntOp     = Coerce SLIT("double2Int#")   doublePrimTy intPrimTy
 851 primOpInfo Int2DoubleOp     = Coerce SLIT("int2Double#")   intPrimTy doublePrimTy
 852
 853 primOpInfo Double2FloatOp   = Coerce SLIT("double2Float#") doublePrimTy floatPrimTy
 854 primOpInfo Float2DoubleOp   = Coerce SLIT("float2Double#") floatPrimTy doublePrimTy
 855
 856 primOpInfo DoubleExpOp  = Monadic   SLIT("expDouble#")     doublePrimTy
 857 primOpInfo DoubleLogOp  = Monadic   SLIT("logDouble#")     doublePrimTy
 858 primOpInfo DoubleSqrtOp = Monadic   SLIT("sqrtDouble#")   doublePrimTy
 859 primOpInfo DoubleSinOp  = Monadic   SLIT("sinDouble#")     doublePrimTy
 860 primOpInfo DoubleCosOp  = Monadic   SLIT("cosDouble#")     doublePrimTy
 861 primOpInfo DoubleTanOp  = Monadic   SLIT("tanDouble#")     doublePrimTy
 862 primOpInfo DoubleAsinOp = Monadic   SLIT("asinDouble#")   doublePrimTy
 863 primOpInfo DoubleAcosOp = Monadic   SLIT("acosDouble#")   doublePrimTy
 864 primOpInfo DoubleAtanOp = Monadic   SLIT("atanDouble#")   doublePrimTy
 865 primOpInfo DoubleSinhOp = Monadic   SLIT("sinhDouble#")   doublePrimTy
 866 primOpInfo DoubleCoshOp = Monadic   SLIT("coshDouble#")   doublePrimTy
 867 primOpInfo DoubleTanhOp = Monadic   SLIT("tanhDouble#")   doublePrimTy
 868 primOpInfo DoublePowerOp= Dyadic    SLIT("powerDouble#")  doublePrimTy
 869 \end{code}
 870
 871 %************************************************************************
 872 %*                                                                      *
 873 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
 874 %*                                                                      *
 875 %************************************************************************
 876
 877 \begin{code}
 878 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
 879
 880 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
 881 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
 882 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
 883
 884 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
 885
 886 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
 887 primOpInfo IntegerDivModOp  = integerDyadic2Results SLIT("divModInteger#")
 888
 889 primOpInfo Integer2IntOp
 890   = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
 891
 892 primOpInfo Int2IntegerOp
 893   = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
 894
 895 primOpInfo Word2IntegerOp
 896   = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
 897
 898 primOpInfo Addr2IntegerOp
 899   = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
 900 \end{code}
 901
 902 Encoding and decoding of floating-point numbers is sorta
 903 Integer-related.
 904
 905 \begin{code}
 906 primOpInfo FloatEncodeOp
 907   = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
 908          floatPrimTyCon FloatRep []
 909
 910 primOpInfo DoubleEncodeOp
 911   = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
 912         doublePrimTyCon DoubleRep []
 913
 914 primOpInfo FloatDecodeOp
 915   = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
 916
 917 primOpInfo DoubleDecodeOp
 918   = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
 919 \end{code}
 920
 921 %************************************************************************
 922 %*                                                                      *
 923 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
 924 %*                                                                      *
 925 %************************************************************************
 926
 927 \begin{code}
 928 primOpInfo NewArrayOp
 929   = let {
 930         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
 931     } in
 932     AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
 933                                 stateAndMutableArrayPrimTyCon [s, elt]
 934
 935 primOpInfo (NewByteArrayOp kind)
 936   = let
 937         s = alphaTy; s_tv = alphaTyVar
 938
 939         (str, _, prim_tycon) = getPrimRepInfo kind
 940
 941         op_str         = _PK_ ("new" ++ str ++ "Array#")
 942     in
 943     AlgResult op_str [s_tv]
 944         [intPrimTy, mkStatePrimTy s]
 945         stateAndMutableByteArrayPrimTyCon [s]
 946
 947 ---------------------------------------------------------------------------
 948
 949 primOpInfo SameMutableArrayOp
 950   = let {
 951         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
 952         mut_arr_ty = mkMutableArrayPrimTy s elt
 953     } in
 954     AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
 955                                    boolTyCon []
 956
 957 primOpInfo SameMutableByteArrayOp
 958   = let {
 959         s = alphaTy; s_tv = alphaTyVar;
 960         mut_arr_ty = mkMutableByteArrayPrimTy s
 961     } in
 962     AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
 963                                    boolTyCon []
 964
 965 ---------------------------------------------------------------------------
 966 -- Primitive arrays of Haskell pointers:
 967
 968 primOpInfo ReadArrayOp
 969   = let {
 970         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
 971     } in
 972     AlgResult SLIT("readArray#") [s_tv, elt_tv]
 973         [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
 974         stateAndPtrPrimTyCon [s, elt]
 975
 976
 977 primOpInfo WriteArrayOp
 978   = let {
 979         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
 980     } in
 981     PrimResult SLIT("writeArray#") [s_tv, elt_tv]
 982         [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
 983         statePrimTyCon VoidRep [s]
 984
 985 primOpInfo IndexArrayOp
 986   = let { elt = alphaTy; elt_tv = alphaTyVar } in
 987     AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
 988                                    liftTyCon [elt]
 989
 990 ---------------------------------------------------------------------------
 991 -- Primitive arrays full of unboxed bytes:
 992
 993 primOpInfo (ReadByteArrayOp kind)
 994   = let
 995         s = alphaTy; s_tv = alphaTyVar
 996
 997         (str, _, prim_tycon) = getPrimRepInfo kind
 998
 999         op_str         = _PK_ ("read" ++ str ++ "Array#")
1000         relevant_tycon = assoc "primOpInfo" tbl kind
1001     in
1002     AlgResult op_str [s_tv]
1003         [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1004         relevant_tycon [s]
1005   where
1006     tbl = [ (CharRep,    stateAndCharPrimTyCon),
1007             (IntRep,     stateAndIntPrimTyCon),
1008             (AddrRep,    stateAndAddrPrimTyCon),
1009             (FloatRep,   stateAndFloatPrimTyCon),
1010             (DoubleRep, stateAndDoublePrimTyCon) ]
1011
1012   -- How come there's no Word byte arrays? ADR
1013
1014 primOpInfo (WriteByteArrayOp kind)
1015   = let
1016         s = alphaTy; s_tv = alphaTyVar
1017
1018         (str, prim_ty, _) = getPrimRepInfo kind
1019         op_str = _PK_ ("write" ++ str ++ "Array#")
1020     in
1021     -- NB: *Prim*Result --
1022     PrimResult op_str [s_tv]
1023         [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1024         statePrimTyCon VoidRep [s]
1025
1026 primOpInfo (IndexByteArrayOp kind)
1027   = let
1028         (str, _, prim_tycon) = getPrimRepInfo kind
1029         op_str = _PK_ ("index" ++ str ++ "Array#")
1030     in
1031     -- NB: *Prim*Result --
1032     PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1033
1034 primOpInfo (IndexOffAddrOp kind)
1035   = let
1036         (str, _, prim_tycon) = getPrimRepInfo kind
1037         op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1038     in
1039     PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1040
1041 ---------------------------------------------------------------------------
1042 primOpInfo UnsafeFreezeArrayOp
1043   = let {
1044         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1045     } in
1046     AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1047         [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1048         stateAndArrayPrimTyCon [s, elt]
1049
1050 primOpInfo UnsafeFreezeByteArrayOp
1051   = let { s = alphaTy; s_tv = alphaTyVar } in
1052     AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1053         [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1054         stateAndByteArrayPrimTyCon [s]
1055 \end{code}
1056
1057 %************************************************************************
1058 %*                                                                      *
1059 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1060 %*                                                                      *
1061 %************************************************************************
1062
1063 \begin{code}
1064 primOpInfo NewSynchVarOp
1065   = let {
1066         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1067     } in
1068     AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1069                                 stateAndSynchVarPrimTyCon [s, elt]
1070
1071 primOpInfo TakeMVarOp
1072   = let {
1073         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1074     } in
1075     AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1076         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1077         stateAndPtrPrimTyCon [s, elt]
1078
1079 primOpInfo PutMVarOp
1080   = let {
1081         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1082     } in
1083     AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1084         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1085         statePrimTyCon [s]
1086
1087 primOpInfo ReadIVarOp
1088   = let {
1089         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1090     } in
1091     AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1092         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1093         stateAndPtrPrimTyCon [s, elt]
1094
1095 primOpInfo WriteIVarOp
1096   = let {
1097         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1098     } in
1099     AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1100         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1101         statePrimTyCon [s]
1102
1103 \end{code}
1104
1105 %************************************************************************
1106 %*                                                                      *
1107 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1108 %*                                                                      *
1109 %************************************************************************
1110
1111 \begin{code}
1112
1113 primOpInfo DelayOp
1114   = let {
1115         s = alphaTy; s_tv = alphaTyVar
1116     } in
1117     PrimResult SLIT("delay#") [s_tv]
1118         [intPrimTy, mkStatePrimTy s]
1119         statePrimTyCon VoidRep [s]
1120
1121 primOpInfo WaitOp
1122   = let {
1123         s = alphaTy; s_tv = alphaTyVar
1124     } in
1125     PrimResult SLIT("wait#") [s_tv]
1126         [intPrimTy, mkStatePrimTy s]
1127         statePrimTyCon VoidRep [s]
1128
1129 \end{code}
1130
1131
1132 %************************************************************************
1133 %*                                                                      *
1134 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1135 %*                                                                      *
1136 %************************************************************************
1137
1138 A {\em stable pointer} is an index into a table of pointers into the
1139 heap.  Since the garbage collector is told about stable pointers, it
1140 is safe to pass a stable pointer to external systems such as C
1141 routines.
1142
1143 Here's what the operations and types are supposed to be (from
1144 state-interface document).
1145
1146 \begin{verbatim}
1147 makeStablePtr#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1148 freeStablePtr#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1149 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1150 \end{verbatim}
1151
1152 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1153 operation since it doesn't (directly) involve IO operations.  The
1154 reason is that if some optimisation pass decided to duplicate calls to
1155 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1156 massive space leak can result.  Putting it into the PrimIO monad
1157 prevents this.  (Another reason for putting them in a monad is to
1158 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1159 operation.)
1160
1161 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1162 besides, it's not likely to be used from Haskell) so it's not a
1163 primop.
1164
1165 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1166
1167 \begin{code}
1168 primOpInfo MakeStablePtrOp
1169   = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1170         [alphaTy, realWorldStatePrimTy]
1171         stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1172
1173 primOpInfo DeRefStablePtrOp
1174   = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1175         [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1176         stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1177 \end{code}
1178
1179 %************************************************************************
1180 %*                                                                      *
1181 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1182 %*                                                                      *
1183 %************************************************************************
1184
1185 [Alastair Reid is to blame for this!]
1186
1187 These days, (Glasgow) Haskell seems to have a bit of everything from
1188 other languages: strict operations, mutable variables, sequencing,
1189 pointers, etc.  About the only thing left is LISP's ability to test
1190 for pointer equality.  So, let's add it in!
1191
1192 \begin{verbatim}
1193 reallyUnsafePtrEquality :: a -> a -> Int#
1194 \end{verbatim}
1195
1196 which tests any two closures (of the same type) to see if they're the
1197 same.  (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1198 difficulties of trying to box up the result.)
1199
1200 NB This is {\em really unsafe\/} because even something as trivial as
1201 a garbage collection might change the answer by removing indirections.
1202 Still, no-one's forcing you to use it.  If you're worried about little
1203 things like loss of referential transparency, you might like to wrap
1204 it all up in a monad-like thing as John O'Donnell and John Hughes did
1205 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1206 Proceedings?)
1207
1208 I'm thinking of using it to speed up a critical equality test in some
1209 graphics stuff in a context where the possibility of saying that
1210 denotationally equal things aren't isn't a problem (as long as it
1211 doesn't happen too often.)  ADR
1212
1213 To Will: Jim said this was already in, but I can't see it so I'm
1214 adding it.  Up to you whether you add it.  (Note that this could have
1215 been readily implemented using a @veryDangerousCCall@ before they were
1216 removed...)
1217
1218 \begin{code}
1219 primOpInfo ReallyUnsafePtrEqualityOp
1220   = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1221         [alphaTy, alphaTy] intPrimTyCon IntRep []
1222 \end{code}
1223
1224 %************************************************************************
1225 %*                                                                      *
1226 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1227 %*                                                                      *
1228 %************************************************************************
1229
1230 \begin{code}
1231 primOpInfo SeqOp        -- seq# :: a -> Int#
1232   = PrimResult SLIT("seq#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1233
1234 primOpInfo ParOp        -- par# :: a -> Int#
1235   = PrimResult SLIT("par#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1236
1237 primOpInfo ForkOp       -- fork# :: a -> Int#
1238   = PrimResult SLIT("fork#")    [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1239
1240 \end{code}
1241
1242 \begin{code}
1243 #ifdef GRAN
1244
1245 primOpInfo ParGlobalOp  -- parGlobal# :: Int -> a -> b -> b
1246   = AlgResult SLIT("parGlobal#")        [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1247
1248 primOpInfo ParLocalOp   -- parLocal# :: Int -> a -> b -> b
1249   = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1250
1251 primOpInfo ParAtOp      -- parAt# :: Int -> a -> b -> c -> c
1252   = AlgResult SLIT("parAt#")    [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1253
1254 primOpInfo ParAtForNowOp        -- parAtForNow# :: Int -> a -> b -> c -> c
1255   = AlgResult SLIT("parAtForNow#")      [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1256
1257 primOpInfo CopyableOp   -- copyable# :: a -> a
1258   = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1259
1260 primOpInfo NoFollowOp   -- noFollow# :: a -> a
1261   = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1262
1263 #endif {-GRAN-}
1264 \end{code}
1265
1266 %************************************************************************
1267 %*                                                                      *
1268 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1269 %*                                                                      *
1270 %************************************************************************
1271
1272 \begin{code}
1273 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1274   = PrimResult SLIT("errorIO#") []
1275         [mkPrimIoTy unitTy]
1276         statePrimTyCon VoidRep [realWorldTy]
1277 \end{code}
1278
1279 %************************************************************************
1280 %*                                                                      *
1281 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1282 %*                                                                      *
1283 %************************************************************************
1284
1285 \begin{code}
1286 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1287   = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1288   where
1289     (result_tycon, tys_applied, _) = getAppDataTyCon 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 (maybeAppDataTyCon 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       Coerce 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       Coerce 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       Coerce  _ _ 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}