ghc/compiler/prelude/PrimOp.lhs

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