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