ghc/compiler/prelude/PrimOp.lhs

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