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