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