ghc/compiler/prelude/PrimOp.lhs

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