ghc/compiler/prelude/PrimOp.lhs

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