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