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