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 = betaTy; s_tv = betaTyVar
1217
1218         (str, prim_ty, _) = getPrimRepInfo kind
1219         op_str = _PK_ ("write" ++ str ++ "OffAddr#")
1220
1221         tvs
1222           | kind == StablePtrRep = [s_tv,alphaTyVar]
1223           | otherwise            = [s_tv]
1224     in
1225     -- NB: *Prim*Result --
1226     PrimResult op_str tvs
1227         [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1228         statePrimTyCon VoidRep [s]
1229
1230 ---------------------------------------------------------------------------
1231 primOpInfo UnsafeFreezeArrayOp
1232   = let {
1233         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1234     } in
1235     AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1236         [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1237         stateAndArrayPrimTyCon [s, elt]
1238
1239 primOpInfo UnsafeFreezeByteArrayOp
1240   = let { s = alphaTy; s_tv = alphaTyVar } in
1241     AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1242         [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1243         stateAndByteArrayPrimTyCon [s]
1244 ---------------------------------------------------------------------------
1245 primOpInfo SizeofByteArrayOp
1246   = PrimResult
1247         SLIT("sizeofByteArray#") []
1248         [byteArrayPrimTy]
1249         intPrimTyCon IntRep []
1250
1251 primOpInfo SizeofMutableByteArrayOp
1252   = let { s = alphaTy; s_tv = alphaTyVar } in
1253     PrimResult
1254         SLIT("sizeofMutableByteArray#") [s_tv]
1255         [mkMutableByteArrayPrimTy s]
1256         intPrimTyCon IntRep []
1257
1258 \end{code}
1259
1260 %************************************************************************
1261 %*                                                                      *
1262 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1263 %*                                                                      *
1264 %************************************************************************
1265
1266 \begin{code}
1267 primOpInfo NewSynchVarOp
1268   = let {
1269         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1270     } in
1271     AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1272                                 stateAndSynchVarPrimTyCon [s, elt]
1273
1274 primOpInfo SameMVarOp
1275   = let {
1276         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1277         mvar_ty = mkSynchVarPrimTy s elt
1278     } in
1279     AlgResult SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty]
1280         boolTyCon []
1281
1282 primOpInfo TakeMVarOp
1283   = let {
1284         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1285     } in
1286     AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1287         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1288         stateAndPtrPrimTyCon [s, elt]
1289
1290 primOpInfo PutMVarOp
1291   = let {
1292         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1293     } in
1294     AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1295         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1296         statePrimTyCon [s]
1297
1298 primOpInfo ReadIVarOp
1299   = let {
1300         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1301     } in
1302     AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1303         [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1304         stateAndPtrPrimTyCon [s, elt]
1305
1306 primOpInfo WriteIVarOp
1307   = let {
1308         elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1309     } in
1310     AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1311         [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1312         statePrimTyCon [s]
1313
1314 \end{code}
1315
1316 %************************************************************************
1317 %*                                                                      *
1318 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1319 %*                                                                      *
1320 %************************************************************************
1321
1322 \begin{code}
1323
1324 primOpInfo DelayOp
1325   = let {
1326         s = alphaTy; s_tv = alphaTyVar
1327     } in
1328     PrimResult SLIT("delay#") [s_tv]
1329         [intPrimTy, mkStatePrimTy s]
1330         statePrimTyCon VoidRep [s]
1331
1332 primOpInfo WaitReadOp
1333   = let {
1334         s = alphaTy; s_tv = alphaTyVar
1335     } in
1336     PrimResult SLIT("waitRead#") [s_tv]
1337         [intPrimTy, mkStatePrimTy s]
1338         statePrimTyCon VoidRep [s]
1339
1340 primOpInfo WaitWriteOp
1341   = let {
1342         s = alphaTy; s_tv = alphaTyVar
1343     } in
1344     PrimResult SLIT("waitWrite#") [s_tv]
1345         [intPrimTy, mkStatePrimTy s]
1346         statePrimTyCon VoidRep [s]
1347 \end{code}
1348
1349 %************************************************************************
1350 %*                                                                      *
1351 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1352 %*                                                                      *
1353 %************************************************************************
1354
1355 Not everything should/can be in the Haskell heap. As an example, in an
1356 image processing application written in Haskell, you really would like
1357 to avoid heaving huge images between different space or generations of
1358 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1359 which refer to some externally allocated structure/value. Using @ForeignObj@,
1360 just a reference to an image is present in the heap, the image could then
1361 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1362 a completely separate address space alltogether.
1363
1364 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1365 associated with the object is invoked (currently, each ForeignObj has a
1366 direct reference to its finaliser).  -- SOF
1367
1368 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1369
1370 \begin{pseudocode}
1371 makeForeignObj# :: Addr#  -- foreign object
1372                 -> Addr#  -- ptr to its finaliser routine
1373                 -> StateAndForeignObj# _RealWorld# ForeignObj#
1374 \end{pseudocode}
1375
1376
1377 \begin{code}
1378 primOpInfo MakeForeignObjOp
1379   = AlgResult SLIT("makeForeignObj#") []
1380         [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1381         stateAndForeignObjPrimTyCon [realWorldTy]
1382 \end{code}
1383
1384 [Experimental--SOF]
1385 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1386 the external object wrapped up inside a @ForeignObj@. This primitive is used
1387 when a mixed programming interface of implicit and explicit de-allocation is used,
1388 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1389 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1390 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1391 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1392 We deal with this situation, by allowing the programmer to destructively modify
1393 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1394 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1395
1396 \begin{pseudocode}
1397 writeForeignObj# :: ForeignObj#  -- foreign object
1398                 -> Addr#        -- new data value
1399                 -> StateAndForeignObj# _RealWorld# ForeignObj#
1400 \end{pseudocode}
1401
1402 \begin{code}
1403 primOpInfo WriteForeignObjOp
1404  = let {
1405         s = alphaTy; s_tv = alphaTyVar
1406     } in
1407    PrimResult SLIT("writeForeignObj#") [s_tv]
1408         [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1409         statePrimTyCon VoidRep [s]
1410 \end{code}
1411
1412 %************************************************************************
1413 %*                                                                      *
1414 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1415 %*                                                                      *
1416 %************************************************************************
1417
1418 A {\em stable pointer} is an index into a table of pointers into the
1419 heap.  Since the garbage collector is told about stable pointers, it
1420 is safe to pass a stable pointer to external systems such as C
1421 routines.
1422
1423 Here's what the operations and types are supposed to be (from
1424 state-interface document).
1425
1426 \begin{verbatim}
1427 makeStablePtr#  :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1428 freeStablePtr#  :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1429 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1430 \end{verbatim}
1431
1432 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1433 operation since it doesn't (directly) involve IO operations.  The
1434 reason is that if some optimisation pass decided to duplicate calls to
1435 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1436 massive space leak can result.  Putting it into the PrimIO monad
1437 prevents this.  (Another reason for putting them in a monad is to
1438 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1439 operation.)
1440
1441 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1442 besides, it's not likely to be used from Haskell) so it's not a
1443 primop.
1444
1445 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1446
1447 \begin{code}
1448 primOpInfo MakeStablePtrOp
1449   = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1450         [alphaTy, realWorldStatePrimTy]
1451         stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1452
1453 primOpInfo DeRefStablePtrOp
1454   = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1455         [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1456         stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1457 \end{code}
1458
1459 %************************************************************************
1460 %*                                                                      *
1461 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1462 %*                                                                      *
1463 %************************************************************************
1464
1465 [Alastair Reid is to blame for this!]
1466
1467 These days, (Glasgow) Haskell seems to have a bit of everything from
1468 other languages: strict operations, mutable variables, sequencing,
1469 pointers, etc.  About the only thing left is LISP's ability to test
1470 for pointer equality.  So, let's add it in!
1471
1472 \begin{verbatim}
1473 reallyUnsafePtrEquality :: a -> a -> Int#
1474 \end{verbatim}
1475
1476 which tests any two closures (of the same type) to see if they're the
1477 same.  (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1478 difficulties of trying to box up the result.)
1479
1480 NB This is {\em really unsafe\/} because even something as trivial as
1481 a garbage collection might change the answer by removing indirections.
1482 Still, no-one's forcing you to use it.  If you're worried about little
1483 things like loss of referential transparency, you might like to wrap
1484 it all up in a monad-like thing as John O'Donnell and John Hughes did
1485 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1486 Proceedings?)
1487
1488 I'm thinking of using it to speed up a critical equality test in some
1489 graphics stuff in a context where the possibility of saying that
1490 denotationally equal things aren't isn't a problem (as long as it
1491 doesn't happen too often.)  ADR
1492
1493 To Will: Jim said this was already in, but I can't see it so I'm
1494 adding it.  Up to you whether you add it.  (Note that this could have
1495 been readily implemented using a @veryDangerousCCall@ before they were
1496 removed...)
1497
1498 \begin{code}
1499 primOpInfo ReallyUnsafePtrEqualityOp
1500   = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1501         [alphaTy, alphaTy] intPrimTyCon IntRep []
1502 \end{code}
1503
1504 %************************************************************************
1505 %*                                                                      *
1506 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1507 %*                                                                      *
1508 %************************************************************************
1509
1510 \begin{code}
1511 primOpInfo SeqOp        -- seq# :: a -> Int#
1512   = PrimResult SLIT("seq#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1513
1514 primOpInfo ParOp        -- par# :: a -> Int#
1515   = PrimResult SLIT("par#")     [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1516
1517 primOpInfo ForkOp       -- fork# :: a -> Int#
1518   = PrimResult SLIT("fork#")    [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1519
1520 \end{code}
1521
1522 \begin{code}
1523 -- HWL: The first 4 Int# in all par... annotations denote:
1524 --   name, granularity info, size of result, degree of parallelism
1525 --      Same  structure as _seq_ i.e. returns Int#
1526
1527 primOpInfo ParGlobalOp  -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1528   = PrimResult SLIT("parGlobal#")       [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1529
1530 primOpInfo ParLocalOp   -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1531   = PrimResult SLIT("parLocal#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1532
1533 primOpInfo ParAtOp      -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1534   = PrimResult SLIT("parAt#")   [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep []   -- liftTyCon [gammaTy]
1535
1536 primOpInfo ParAtAbsOp   -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1537   = PrimResult SLIT("parAtAbs#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1538
1539 primOpInfo ParAtRelOp   -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1540   = PrimResult SLIT("parAtRel#")        [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep []   -- liftTyCon [betaTy]
1541
1542 primOpInfo ParAtForNowOp        -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1543   = PrimResult SLIT("parAtForNow#")     [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep []   -- liftTyCon [gammaTy]
1544
1545 primOpInfo CopyableOp   -- copyable# :: a -> a
1546   = PrimResult SLIT("copyable#")        [alphaTyVar] [alphaTy] intPrimTyCon IntRep []   -- liftTyCon [alphaTy]
1547
1548 primOpInfo NoFollowOp   -- noFollow# :: a -> a
1549   = PrimResult SLIT("noFollow#")        [alphaTyVar] [alphaTy] intPrimTyCon IntRep []   -- liftTyCon [alphaTy]
1550 \end{code}
1551
1552 %************************************************************************
1553 %*                                                                      *
1554 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1555 %*                                                                      *
1556 %************************************************************************
1557
1558 \begin{code}
1559 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1560 primOpInfo ErrorIOPrimOp
1561   = PrimResult SLIT("errorIO#") [alphaTyVar]
1562         [mkFunTy realWorldStatePrimTy alphaTy]
1563         statePrimTyCon VoidRep [realWorldTy]
1564 \end{code}
1565
1566 %************************************************************************
1567 %*                                                                      *
1568 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1569 %*                                                                      *
1570 %************************************************************************
1571
1572 \begin{code}
1573 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1574   = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1575   where
1576     (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1577
1578 #ifdef DEBUG
1579 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1580 #endif
1581 \end{code}
1582
1583 %************************************************************************
1584 %*                                                                      *
1585 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1586 %*                                                                      *
1587 %************************************************************************
1588
1589 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1590 with @Integers@ can trigger GC.  Here we describe the heap requirements
1591 of the various @PrimOps@.  For most, no heap is required.  For a few,
1592 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1593 be combined with the rest of the heap usage in the basic block.  For an
1594 unfortunate few, some unknown amount of heap is required (these are the
1595 ops which can trigger GC).
1596
1597 \begin{code}
1598 data HeapRequirement
1599     = NoHeapRequired
1600     | FixedHeapRequired HeapOffset
1601     | VariableHeapRequired
1602
1603 primOpHeapReq :: PrimOp -> HeapRequirement
1604
1605 primOpHeapReq NewArrayOp        = VariableHeapRequired
1606 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1607
1608 primOpHeapReq IntegerAddOp      = VariableHeapRequired
1609 primOpHeapReq IntegerSubOp      = VariableHeapRequired
1610 primOpHeapReq IntegerMulOp      = VariableHeapRequired
1611 primOpHeapReq IntegerQuotRemOp  = VariableHeapRequired
1612 primOpHeapReq IntegerDivModOp   = VariableHeapRequired
1613 primOpHeapReq IntegerNegOp      = VariableHeapRequired
1614 primOpHeapReq Int2IntegerOp     = FixedHeapRequired
1615                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1616                                           (intOff mIN_MP_INT_SIZE))
1617 primOpHeapReq Word2IntegerOp    = FixedHeapRequired
1618                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1619                                           (intOff mIN_MP_INT_SIZE))
1620 primOpHeapReq Addr2IntegerOp    = VariableHeapRequired
1621 primOpHeapReq IntegerToInt64Op  = FixedHeapRequired
1622                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1623                                           (intOff mIN_MP_INT_SIZE))
1624 primOpHeapReq Word64ToIntegerOp = FixedHeapRequired
1625                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1626                                           (intOff mIN_MP_INT_SIZE))
1627 primOpHeapReq Int64ToIntegerOp  = FixedHeapRequired
1628                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1629                                           (intOff mIN_MP_INT_SIZE))
1630 primOpHeapReq IntegerToWord64Op = FixedHeapRequired
1631                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1632                                           (intOff mIN_MP_INT_SIZE))
1633 primOpHeapReq FloatDecodeOp     = FixedHeapRequired
1634                                   (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1635                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1636                                           (intOff mIN_MP_INT_SIZE)))
1637 primOpHeapReq DoubleDecodeOp    = FixedHeapRequired
1638                                   (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1639                                   (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1640                                           (intOff mIN_MP_INT_SIZE)))
1641
1642 {-
1643   ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1644   or if it returns a ForeignObj.
1645
1646   Hmm..the allocation for makeForeignObj# is known (and fixed), so
1647   why do we need to be so indeterminate about it? --SOF
1648 -}
1649 primOpHeapReq (CCallOp _ _ mayGC@True  _ _ _) = VariableHeapRequired
1650 primOpHeapReq (CCallOp _ _ mayGC@False _ _ _) = NoHeapRequired
1651
1652 primOpHeapReq MakeForeignObjOp  = VariableHeapRequired
1653 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1654
1655 -- this occasionally has to expand the Stable Pointer table
1656 primOpHeapReq MakeStablePtrOp   = VariableHeapRequired
1657
1658 -- These four only need heap space with the native code generator
1659 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1660
1661 primOpHeapReq IntegerCmpOp      = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1662 primOpHeapReq Integer2IntOp     = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1663 primOpHeapReq Integer2WordOp    = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1664 primOpHeapReq FloatEncodeOp     = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1665 primOpHeapReq DoubleEncodeOp    = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1666
1667 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1668 primOpHeapReq NewSynchVarOp     = FixedHeapRequired
1669                                   (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1670
1671 -- Sparking ops no longer allocate any heap; however, _fork_ may
1672 -- require a context switch to clear space in the required thread
1673 -- pool, and that requires liveness information.
1674
1675 primOpHeapReq ParOp             = NoHeapRequired
1676 primOpHeapReq ForkOp            = VariableHeapRequired
1677
1678 -- A SeqOp requires unknown space to evaluate its argument
1679 primOpHeapReq SeqOp             = VariableHeapRequired
1680
1681 -- GranSim sparks are stgMalloced i.e. no heap required
1682 primOpHeapReq ParGlobalOp       = NoHeapRequired
1683 primOpHeapReq ParLocalOp        = NoHeapRequired
1684 primOpHeapReq ParAtOp           = NoHeapRequired
1685 primOpHeapReq ParAtAbsOp        = NoHeapRequired
1686 primOpHeapReq ParAtRelOp        = NoHeapRequired
1687 primOpHeapReq ParAtForNowOp     = NoHeapRequired
1688 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1689 primOpHeapReq CopyableOp        = NoHeapRequired
1690 primOpHeapReq NoFollowOp        = NoHeapRequired
1691
1692 primOpHeapReq other_op          = NoHeapRequired
1693 \end{code}
1694
1695 The amount of stack required by primops.
1696
1697 \begin{code}
1698 data StackRequirement
1699   = NoStackRequired
1700   | FixedStackRequired Int {-AStack-} Int {-BStack-}
1701   | VariableStackRequired
1702
1703 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1704 primOpStackRequired _     = VariableStackRequired
1705 -- ToDo: be more specific for certain primops (currently only used for seq)
1706 \end{code}
1707
1708 Primops which can trigger GC have to be called carefully.
1709 In particular, their arguments are guaranteed to be in registers,
1710 and a liveness mask tells which regs are live.
1711
1712 \begin{code}
1713 primOpCanTriggerGC op
1714   = case op of
1715         TakeMVarOp  -> True
1716         ReadIVarOp  -> True
1717         DelayOp     -> True
1718         WaitReadOp  -> True
1719         WaitWriteOp -> True
1720         _           ->
1721             case primOpHeapReq op of
1722                 VariableHeapRequired -> True
1723                 _                    -> False
1724 \end{code}
1725
1726 Sometimes we may choose to execute a PrimOp even though it isn't
1727 certain that its result will be required; ie execute them
1728 ``speculatively''.  The same thing as ``cheap eagerness.'' Usually
1729 this is OK, because PrimOps are usually cheap, but it isn't OK for
1730 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1731
1732 See also @primOpIsCheap@ (below).
1733
1734 There should be no worries about side effects; that's all taken care
1735 of by data dependencies.
1736
1737 \begin{code}
1738 primOpOkForSpeculation :: PrimOp -> Bool
1739
1740 -- Int.
1741 primOpOkForSpeculation IntQuotOp        = False         -- Divide by zero
1742 primOpOkForSpeculation IntRemOp         = False         -- Divide by zero
1743
1744 -- Integer
1745 primOpOkForSpeculation IntegerQuotRemOp = False         -- Divide by zero
1746 primOpOkForSpeculation IntegerDivModOp  = False         -- Divide by zero
1747
1748 -- Float.  ToDo: tan? tanh?
1749 primOpOkForSpeculation FloatDivOp       = False         -- Divide by zero
1750 primOpOkForSpeculation FloatLogOp       = False         -- Log of zero
1751 primOpOkForSpeculation FloatAsinOp      = False         -- Arg out of domain
1752 primOpOkForSpeculation FloatAcosOp      = False         -- Arg out of domain
1753
1754 -- Double.  ToDo: tan? tanh?
1755 primOpOkForSpeculation DoubleDivOp      = False         -- Divide by zero
1756 primOpOkForSpeculation DoubleLogOp      = False         -- Log of zero
1757 primOpOkForSpeculation DoubleAsinOp     = False         -- Arg out of domain
1758 primOpOkForSpeculation DoubleAcosOp     = False         -- Arg out of domain
1759
1760 -- CCall
1761 primOpOkForSpeculation (CCallOp _ _ _ _ _ _) = False    -- Could be expensive!
1762
1763 -- errorIO#
1764 primOpOkForSpeculation ErrorIOPrimOp    = False         -- Could be disastrous!
1765
1766 -- parallel
1767 primOpOkForSpeculation ParOp            = False         -- Could be expensive!
1768 primOpOkForSpeculation ForkOp           = False         -- Likewise
1769 primOpOkForSpeculation SeqOp            = False         -- Likewise
1770
1771 primOpOkForSpeculation ParGlobalOp      = False         -- Could be expensive!
1772 primOpOkForSpeculation ParLocalOp       = False         -- Could be expensive!
1773 primOpOkForSpeculation ParAtOp          = False         -- Could be expensive!
1774 primOpOkForSpeculation ParAtAbsOp       = False         -- Could be expensive!
1775 primOpOkForSpeculation ParAtRelOp       = False         -- Could be expensive!
1776 primOpOkForSpeculation ParAtForNowOp    = False         -- Could be expensive!
1777 primOpOkForSpeculation CopyableOp       = False         -- only tags closure
1778 primOpOkForSpeculation NoFollowOp       = False         -- only tags closure
1779
1780 -- The default is "yes it's ok for speculation"
1781 primOpOkForSpeculation other_op         = True
1782 \end{code}
1783
1784 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK
1785 WARNING), we just borrow some other predicates for a
1786 what-should-be-good-enough test.
1787 \begin{code}
1788 primOpIsCheap op
1789   = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1790 \end{code}
1791
1792 And some primops have side-effects and so, for example, must not be
1793 duplicated.
1794
1795 \begin{code}
1796 fragilePrimOp :: PrimOp -> Bool
1797
1798 fragilePrimOp ParOp = True
1799 fragilePrimOp ForkOp = True
1800 fragilePrimOp SeqOp = True
1801 fragilePrimOp MakeForeignObjOp  = True  -- SOF
1802 fragilePrimOp WriteForeignObjOp = True  -- SOF
1803 fragilePrimOp MakeStablePtrOp  = True
1804 fragilePrimOp DeRefStablePtrOp = True  -- ??? JSM & ADR
1805
1806 fragilePrimOp ParGlobalOp = True
1807 fragilePrimOp ParLocalOp = True
1808 fragilePrimOp ParAtOp = True
1809 fragilePrimOp ParAtAbsOp = True
1810 fragilePrimOp ParAtRelOp = True
1811 fragilePrimOp ParAtForNowOp = True
1812 fragilePrimOp CopyableOp = True  -- Possibly not.  ASP
1813 fragilePrimOp NoFollowOp = True  -- Possibly not.  ASP
1814
1815 fragilePrimOp other = False
1816 \end{code}
1817
1818 Primitive operations that perform calls need wrappers to save any live variables
1819 that are stored in caller-saves registers
1820
1821 \begin{code}
1822 primOpNeedsWrapper :: PrimOp -> Bool
1823
1824 primOpNeedsWrapper (CCallOp _ _ _ _ _ _) = True
1825
1826 primOpNeedsWrapper NewArrayOp            = True -- ToDo: for nativeGen only!(JSM)
1827 primOpNeedsWrapper (NewByteArrayOp _)    = True
1828
1829 primOpNeedsWrapper IntegerAddOp          = True
1830 primOpNeedsWrapper IntegerSubOp          = True
1831 primOpNeedsWrapper IntegerMulOp          = True
1832 primOpNeedsWrapper IntegerQuotRemOp      = True
1833 primOpNeedsWrapper IntegerDivModOp       = True
1834 primOpNeedsWrapper IntegerNegOp          = True
1835 primOpNeedsWrapper IntegerCmpOp          = True
1836 primOpNeedsWrapper Integer2IntOp         = True
1837 primOpNeedsWrapper Integer2WordOp        = True
1838 primOpNeedsWrapper Int2IntegerOp         = True
1839 primOpNeedsWrapper Word2IntegerOp        = True
1840 primOpNeedsWrapper Addr2IntegerOp        = True
1841 primOpNeedsWrapper IntegerToInt64Op      = True
1842 primOpNeedsWrapper IntegerToWord64Op     = True
1843 primOpNeedsWrapper Word64ToIntegerOp     = True
1844 primOpNeedsWrapper Int64ToIntegerOp      = True
1845
1846 primOpNeedsWrapper FloatExpOp           = True
1847 primOpNeedsWrapper FloatLogOp           = True
1848 primOpNeedsWrapper FloatSqrtOp          = True
1849 primOpNeedsWrapper FloatSinOp           = True
1850 primOpNeedsWrapper FloatCosOp           = True
1851 primOpNeedsWrapper FloatTanOp           = True
1852 primOpNeedsWrapper FloatAsinOp          = True
1853 primOpNeedsWrapper FloatAcosOp          = True
1854 primOpNeedsWrapper FloatAtanOp          = True
1855 primOpNeedsWrapper FloatSinhOp          = True
1856 primOpNeedsWrapper FloatCoshOp          = True
1857 primOpNeedsWrapper FloatTanhOp          = True
1858 primOpNeedsWrapper FloatPowerOp         = True
1859 primOpNeedsWrapper FloatEncodeOp        = True
1860 primOpNeedsWrapper FloatDecodeOp        = True
1861
1862 primOpNeedsWrapper DoubleExpOp          = True
1863 primOpNeedsWrapper DoubleLogOp          = True
1864 primOpNeedsWrapper DoubleSqrtOp         = True
1865 primOpNeedsWrapper DoubleSinOp          = True
1866 primOpNeedsWrapper DoubleCosOp          = True
1867 primOpNeedsWrapper DoubleTanOp          = True
1868 primOpNeedsWrapper DoubleAsinOp         = True
1869 primOpNeedsWrapper DoubleAcosOp         = True
1870 primOpNeedsWrapper DoubleAtanOp         = True
1871 primOpNeedsWrapper DoubleSinhOp         = True
1872 primOpNeedsWrapper DoubleCoshOp         = True
1873 primOpNeedsWrapper DoubleTanhOp         = True
1874 primOpNeedsWrapper DoublePowerOp        = True
1875 primOpNeedsWrapper DoubleEncodeOp       = True
1876 primOpNeedsWrapper DoubleDecodeOp       = True
1877
1878 primOpNeedsWrapper MakeForeignObjOp     = True
1879 primOpNeedsWrapper WriteForeignObjOp    = True
1880 primOpNeedsWrapper MakeStablePtrOp      = True
1881 primOpNeedsWrapper DeRefStablePtrOp     = True
1882
1883 primOpNeedsWrapper TakeMVarOp           = True
1884 primOpNeedsWrapper PutMVarOp            = True
1885 primOpNeedsWrapper ReadIVarOp           = True
1886
1887 primOpNeedsWrapper DelayOp              = True
1888 primOpNeedsWrapper WaitReadOp           = True
1889 primOpNeedsWrapper WaitWriteOp          = True
1890
1891 primOpNeedsWrapper other_op             = False
1892 \end{code}
1893
1894 \begin{code}
1895 primOp_str op
1896   = case (primOpInfo op) of
1897       Dyadic     str _         -> str
1898       Monadic    str _         -> str
1899       Compare    str _         -> str
1900       Coercing   str _ _       -> str
1901       PrimResult str _ _ _ _ _ -> str
1902       AlgResult  str _ _ _ _   -> str
1903 \end{code}
1904
1905 @primOpType@ duplicates some work of @primOpId@, but since we
1906 grab types pretty often...
1907 \begin{code}
1908 primOpType :: PrimOp -> Type
1909
1910 primOpType op
1911   = case (primOpInfo op) of
1912       Dyadic str ty ->      dyadic_fun_ty ty
1913       Monadic str ty ->     monadic_fun_ty ty
1914       Compare str ty ->     compare_fun_ty ty
1915       Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1916
1917       PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1918         mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1919
1920       AlgResult str tyvars arg_tys tycon res_tys ->
1921         mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1922 \end{code}
1923
1924 \begin{code}
1925 data PrimOpResultInfo
1926   = ReturnsPrim     PrimRep
1927   | ReturnsAlg      TyCon
1928
1929 -- ToDo: Deal with specialised PrimOps
1930 --       Will need to return specialised tycon and data constructors
1931
1932 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1933
1934 getPrimOpResultInfo op
1935   = case (primOpInfo op) of
1936       Dyadic  _ ty               -> ReturnsPrim (typePrimRep ty)
1937       Monadic _ ty               -> ReturnsPrim (typePrimRep ty)
1938       Compare _ ty               -> ReturnsAlg  boolTyCon
1939       Coercing  _ _ ty           -> ReturnsPrim (typePrimRep ty)
1940       PrimResult _ _ _ _ kind _  -> ReturnsPrim kind
1941       AlgResult _ _ _ tycon _    -> ReturnsAlg  tycon
1942
1943 isCompareOp :: PrimOp -> Bool
1944
1945 isCompareOp op
1946   = case primOpInfo op of
1947       Compare _ _ -> True
1948       _           -> False
1949 \end{code}
1950
1951 The commutable ops are those for which we will try to move constants
1952 to the right hand side for strength reduction.
1953
1954 \begin{code}
1955 commutableOp :: PrimOp -> Bool
1956
1957 commutableOp CharEqOp     = True
1958 commutableOp CharNeOp     = True
1959 commutableOp IntAddOp     = True
1960 commutableOp IntMulOp     = True
1961 commutableOp AndOp        = True
1962 commutableOp OrOp         = True
1963 commutableOp XorOp        = True
1964 commutableOp IntEqOp      = True
1965 commutableOp IntNeOp      = True
1966 commutableOp IntegerAddOp = True
1967 commutableOp IntegerMulOp = True
1968 commutableOp FloatAddOp   = True
1969 commutableOp FloatMulOp   = True
1970 commutableOp FloatEqOp    = True
1971 commutableOp FloatNeOp    = True
1972 commutableOp DoubleAddOp  = True
1973 commutableOp DoubleMulOp  = True
1974 commutableOp DoubleEqOp   = True
1975 commutableOp DoubleNeOp   = True
1976 commutableOp _            = False
1977 \end{code}
1978
1979 Utils:
1980 \begin{code}
1981 dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
1982 monadic_fun_ty ty = mkFunTy  ty ty
1983 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1984 \end{code}
1985
1986 Output stuff:
1987 \begin{code}
1988 pprPrimOp  :: PrimOp -> SDoc
1989 showPrimOp :: PrimOp -> String
1990
1991 showPrimOp op = showSDoc (pprPrimOp op)
1992
1993 pprPrimOp (CCallOp fun is_casm may_gc cconv arg_tys res_ty)
1994   = let
1995         callconv = text "{-" <> pprCallConv cconv <> text "-}"
1996
1997         before
1998           | is_casm && may_gc = "_casm_GC_ ``"
1999           | is_casm           = "_casm_ ``"
2000           | may_gc            = "_ccall_GC_ "
2001           | otherwise         = "_ccall_ "
2002
2003         after
2004           | is_casm   = text "''"
2005           | otherwise = empty
2006
2007         pp_tys
2008           = hsep (map pprParendType (res_ty:arg_tys))
2009
2010         ppr_fun =
2011          case fun of
2012            Right _ -> ptext SLIT("<dynamic>")
2013            Left fn -> ptext fn
2014
2015     in
2016     hcat [ ifPprDebug callconv
2017          , text before , ppr_fun , after, space, brackets pp_tys]
2018
2019 pprPrimOp other_op
2020   = getPprStyle $ \ sty ->
2021     if codeStyle sty then       -- For C just print the primop itself
2022        identToC str
2023     else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2024        ptext SLIT("PrelGHC.") <> ptext str
2025     else                        -- Unqualified is good enough
2026        ptext str
2027   where
2028     str = primOp_str other_op
2029
2030
2031 instance Outputable PrimOp where
2032     ppr op = pprPrimOp op
2033 \end{code}