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