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