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