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