2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[PrimOp]{Primitive operations (machine-level)}
8 PrimOp(..), allThePrimOps,
9 primOpType, primOpSig, primOpUsg, primOpArity,
10 mkPrimOpIdName, primOpRdrName, primOpTag, primOpOcc,
14 primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
15 primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
18 getPrimOpResultInfo, PrimOpResultInfo(..),
23 #include "HsVersions.h"
25 import PrimRep -- most of it
29 import Demand ( Demand, wwLazy, wwPrim, wwStrict )
30 import Var ( TyVar, Id )
31 import CallConv ( CallConv, pprCallConv )
32 import PprType ( pprParendType )
33 import Name ( Name, mkWiredInIdName )
34 import RdrName ( RdrName, mkRdrQual )
35 import OccName ( OccName, pprOccName, mkSrcVarOcc )
36 import TyCon ( TyCon, tyConArity )
37 import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
38 mkTyConTy, mkTyConApp, typePrimRep,mkTyVarTy,
39 splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
42 import Unique ( Unique, mkPrimOpIdUnique )
43 import BasicTypes ( Arity )
44 import PrelMods ( pREL_GHC, pREL_GHC_Name )
46 import Util ( assoc, zipWithEqual )
47 import GlaExts ( Int(..), Int#, (==#) )
50 %************************************************************************
52 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
54 %************************************************************************
56 These are in \tr{state-interface.verb} order.
60 -- dig the FORTRAN/C influence on the names...
64 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
65 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
66 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
67 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
68 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
69 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
75 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
77 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
84 | WordQuotOp | WordRemOp
85 | AndOp | OrOp | NotOp | XorOp
86 | SllOp | SrlOp -- shift {left,right} {logical}
87 | Int2WordOp | Word2IntOp -- casts
90 | Int2AddrOp | Addr2IntOp -- casts
92 -- Float#-related ops:
93 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
94 | Float2IntOp | Int2FloatOp
96 | FloatExpOp | FloatLogOp | FloatSqrtOp
97 | FloatSinOp | FloatCosOp | FloatTanOp
98 | FloatAsinOp | FloatAcosOp | FloatAtanOp
99 | FloatSinhOp | FloatCoshOp | FloatTanhOp
100 -- not all machines have these available conveniently:
101 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
102 | FloatPowerOp -- ** op
104 -- Double#-related ops:
105 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
106 | Double2IntOp | Int2DoubleOp
107 | Double2FloatOp | Float2DoubleOp
109 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
110 | DoubleSinOp | DoubleCosOp | DoubleTanOp
111 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
112 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
113 -- not all machines have these available conveniently:
114 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
115 | DoublePowerOp -- ** op
117 -- Integer (and related...) ops:
118 -- slightly weird -- to match GMP package.
119 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
120 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
121 | IntegerIntGcdOp | IntegerDivExactOp
122 | IntegerQuotOp | IntegerRemOp
127 | Integer2IntOp | Integer2WordOp
128 | Int2IntegerOp | Word2IntegerOp
130 -- casting to/from Integer and 64-bit (un)signed quantities.
131 | IntegerToInt64Op | Int64ToIntegerOp
132 | IntegerToWord64Op | Word64ToIntegerOp
138 -- primitive ops for primitive arrays
141 | NewByteArrayOp PrimRep
144 | SameMutableByteArrayOp
146 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
148 | ReadByteArrayOp PrimRep
149 | WriteByteArrayOp PrimRep
150 | IndexByteArrayOp PrimRep
151 | IndexOffAddrOp PrimRep
152 | WriteOffAddrOp PrimRep
153 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
154 -- This is just a cheesy encoding of a bunch of ops.
155 -- Note that ForeignObjRep is not included -- the only way of
156 -- creating a ForeignObj is with a ccall or casm.
157 | IndexOffForeignObjOp PrimRep
159 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
161 | SizeofByteArrayOp | SizeofMutableByteArrayOp
179 | BlockAsyncExceptionsOp
180 | UnblockAsyncExceptionsOp
202 A special ``trap-door'' to use in making calls direct to C functions:
205 FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
206 Unique) -- Right u => first argument (an Addr#) is the function pointer
207 -- (unique is used to generate a 'typedef' to cast
208 -- the function pointer if compiling the ccall# down to
209 -- .hc code - can't do this inline for tedious reasons.)
211 Bool -- True <=> really a "casm"
212 Bool -- True <=> might invoke Haskell GC
213 CallConv -- calling convention to use.
215 -- (... to be continued ... )
218 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
219 (See @primOpInfo@ for details.)
221 Note: that first arg and part of the result should be the system state
222 token (which we carry around to fool over-zealous optimisers) but
223 which isn't actually passed.
225 For example, we represent
227 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
233 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
234 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
238 (AlgAlts [ ( FloatPrimAndIoWorld,
240 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
246 Nota Bene: there are some people who find the empty list of types in
247 the @Prim@ somewhat puzzling and would represent the above by
251 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
252 -- :: /\ alpha1, alpha2 alpha3, alpha4.
253 -- alpha1 -> alpha2 -> alpha3 -> alpha4
254 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
257 (AlgAlts [ ( FloatPrimAndIoWorld,
259 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
265 But, this is a completely different way of using @CCallOp@. The most
266 major changes required if we switch to this are in @primOpInfo@, and
267 the desugarer. The major difficulty is in moving the HeapRequirement
268 stuff somewhere appropriate. (The advantage is that we could simplify
269 @CCallOp@ and record just the number of arguments with corresponding
270 simplifications in reading pragma unfoldings, the simplifier,
271 instantiation (etc) of core expressions, ... . Maybe we should think
272 about using it this way?? ADR)
275 -- (... continued from above ... )
277 -- Operation to test two closure addresses for equality (yes really!)
278 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
279 | ReallyUnsafePtrEqualityOp
294 -- more parallel stuff
295 | ParGlobalOp -- named global par
296 | ParLocalOp -- named local par
297 | ParAtOp -- specifies destination of local par
298 | ParAtAbsOp -- specifies destination of local par (abs processor)
299 | ParAtRelOp -- specifies destination of local par (rel processor)
300 | ParAtForNowOp -- specifies initial destination of global par
301 | CopyableOp -- marks copyable code
302 | NoFollowOp -- marks non-followup expression
309 Used for the Ord instance
312 primOpTag :: PrimOp -> Int
313 primOpTag op = IBOX( tagOf_PrimOp op )
315 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
316 tagOf_PrimOp CharGeOp = ILIT( 2)
317 tagOf_PrimOp CharEqOp = ILIT( 3)
318 tagOf_PrimOp CharNeOp = ILIT( 4)
319 tagOf_PrimOp CharLtOp = ILIT( 5)
320 tagOf_PrimOp CharLeOp = ILIT( 6)
321 tagOf_PrimOp IntGtOp = ILIT( 7)
322 tagOf_PrimOp IntGeOp = ILIT( 8)
323 tagOf_PrimOp IntEqOp = ILIT( 9)
324 tagOf_PrimOp IntNeOp = ILIT( 10)
325 tagOf_PrimOp IntLtOp = ILIT( 11)
326 tagOf_PrimOp IntLeOp = ILIT( 12)
327 tagOf_PrimOp WordGtOp = ILIT( 13)
328 tagOf_PrimOp WordGeOp = ILIT( 14)
329 tagOf_PrimOp WordEqOp = ILIT( 15)
330 tagOf_PrimOp WordNeOp = ILIT( 16)
331 tagOf_PrimOp WordLtOp = ILIT( 17)
332 tagOf_PrimOp WordLeOp = ILIT( 18)
333 tagOf_PrimOp AddrGtOp = ILIT( 19)
334 tagOf_PrimOp AddrGeOp = ILIT( 20)
335 tagOf_PrimOp AddrEqOp = ILIT( 21)
336 tagOf_PrimOp AddrNeOp = ILIT( 22)
337 tagOf_PrimOp AddrLtOp = ILIT( 23)
338 tagOf_PrimOp AddrLeOp = ILIT( 24)
339 tagOf_PrimOp FloatGtOp = ILIT( 25)
340 tagOf_PrimOp FloatGeOp = ILIT( 26)
341 tagOf_PrimOp FloatEqOp = ILIT( 27)
342 tagOf_PrimOp FloatNeOp = ILIT( 28)
343 tagOf_PrimOp FloatLtOp = ILIT( 29)
344 tagOf_PrimOp FloatLeOp = ILIT( 30)
345 tagOf_PrimOp DoubleGtOp = ILIT( 31)
346 tagOf_PrimOp DoubleGeOp = ILIT( 32)
347 tagOf_PrimOp DoubleEqOp = ILIT( 33)
348 tagOf_PrimOp DoubleNeOp = ILIT( 34)
349 tagOf_PrimOp DoubleLtOp = ILIT( 35)
350 tagOf_PrimOp DoubleLeOp = ILIT( 36)
351 tagOf_PrimOp OrdOp = ILIT( 37)
352 tagOf_PrimOp ChrOp = ILIT( 38)
353 tagOf_PrimOp IntAddOp = ILIT( 39)
354 tagOf_PrimOp IntSubOp = ILIT( 40)
355 tagOf_PrimOp IntMulOp = ILIT( 41)
356 tagOf_PrimOp IntQuotOp = ILIT( 42)
357 tagOf_PrimOp IntGcdOp = ILIT( 43)
358 tagOf_PrimOp IntRemOp = ILIT( 44)
359 tagOf_PrimOp IntNegOp = ILIT( 45)
360 tagOf_PrimOp WordQuotOp = ILIT( 47)
361 tagOf_PrimOp WordRemOp = ILIT( 48)
362 tagOf_PrimOp AndOp = ILIT( 49)
363 tagOf_PrimOp OrOp = ILIT( 50)
364 tagOf_PrimOp NotOp = ILIT( 51)
365 tagOf_PrimOp XorOp = ILIT( 52)
366 tagOf_PrimOp SllOp = ILIT( 53)
367 tagOf_PrimOp SrlOp = ILIT( 54)
368 tagOf_PrimOp ISllOp = ILIT( 55)
369 tagOf_PrimOp ISraOp = ILIT( 56)
370 tagOf_PrimOp ISrlOp = ILIT( 57)
371 tagOf_PrimOp IntAddCOp = ILIT( 58)
372 tagOf_PrimOp IntSubCOp = ILIT( 59)
373 tagOf_PrimOp IntMulCOp = ILIT( 60)
374 tagOf_PrimOp Int2WordOp = ILIT( 61)
375 tagOf_PrimOp Word2IntOp = ILIT( 62)
376 tagOf_PrimOp Int2AddrOp = ILIT( 63)
377 tagOf_PrimOp Addr2IntOp = ILIT( 64)
378 tagOf_PrimOp FloatAddOp = ILIT( 65)
379 tagOf_PrimOp FloatSubOp = ILIT( 66)
380 tagOf_PrimOp FloatMulOp = ILIT( 67)
381 tagOf_PrimOp FloatDivOp = ILIT( 68)
382 tagOf_PrimOp FloatNegOp = ILIT( 69)
383 tagOf_PrimOp Float2IntOp = ILIT( 70)
384 tagOf_PrimOp Int2FloatOp = ILIT( 71)
385 tagOf_PrimOp FloatExpOp = ILIT( 72)
386 tagOf_PrimOp FloatLogOp = ILIT( 73)
387 tagOf_PrimOp FloatSqrtOp = ILIT( 74)
388 tagOf_PrimOp FloatSinOp = ILIT( 75)
389 tagOf_PrimOp FloatCosOp = ILIT( 76)
390 tagOf_PrimOp FloatTanOp = ILIT( 77)
391 tagOf_PrimOp FloatAsinOp = ILIT( 78)
392 tagOf_PrimOp FloatAcosOp = ILIT( 79)
393 tagOf_PrimOp FloatAtanOp = ILIT( 80)
394 tagOf_PrimOp FloatSinhOp = ILIT( 81)
395 tagOf_PrimOp FloatCoshOp = ILIT( 82)
396 tagOf_PrimOp FloatTanhOp = ILIT( 83)
397 tagOf_PrimOp FloatPowerOp = ILIT( 84)
398 tagOf_PrimOp DoubleAddOp = ILIT( 85)
399 tagOf_PrimOp DoubleSubOp = ILIT( 86)
400 tagOf_PrimOp DoubleMulOp = ILIT( 87)
401 tagOf_PrimOp DoubleDivOp = ILIT( 88)
402 tagOf_PrimOp DoubleNegOp = ILIT( 89)
403 tagOf_PrimOp Double2IntOp = ILIT( 90)
404 tagOf_PrimOp Int2DoubleOp = ILIT( 91)
405 tagOf_PrimOp Double2FloatOp = ILIT( 92)
406 tagOf_PrimOp Float2DoubleOp = ILIT( 93)
407 tagOf_PrimOp DoubleExpOp = ILIT( 94)
408 tagOf_PrimOp DoubleLogOp = ILIT( 95)
409 tagOf_PrimOp DoubleSqrtOp = ILIT( 96)
410 tagOf_PrimOp DoubleSinOp = ILIT( 97)
411 tagOf_PrimOp DoubleCosOp = ILIT( 98)
412 tagOf_PrimOp DoubleTanOp = ILIT( 99)
413 tagOf_PrimOp DoubleAsinOp = ILIT(100)
414 tagOf_PrimOp DoubleAcosOp = ILIT(101)
415 tagOf_PrimOp DoubleAtanOp = ILIT(102)
416 tagOf_PrimOp DoubleSinhOp = ILIT(103)
417 tagOf_PrimOp DoubleCoshOp = ILIT(104)
418 tagOf_PrimOp DoubleTanhOp = ILIT(105)
419 tagOf_PrimOp DoublePowerOp = ILIT(106)
420 tagOf_PrimOp IntegerAddOp = ILIT(107)
421 tagOf_PrimOp IntegerSubOp = ILIT(108)
422 tagOf_PrimOp IntegerMulOp = ILIT(109)
423 tagOf_PrimOp IntegerGcdOp = ILIT(110)
424 tagOf_PrimOp IntegerIntGcdOp = ILIT(111)
425 tagOf_PrimOp IntegerDivExactOp = ILIT(112)
426 tagOf_PrimOp IntegerQuotOp = ILIT(113)
427 tagOf_PrimOp IntegerRemOp = ILIT(114)
428 tagOf_PrimOp IntegerQuotRemOp = ILIT(115)
429 tagOf_PrimOp IntegerDivModOp = ILIT(116)
430 tagOf_PrimOp IntegerNegOp = ILIT(117)
431 tagOf_PrimOp IntegerCmpOp = ILIT(118)
432 tagOf_PrimOp IntegerCmpIntOp = ILIT(119)
433 tagOf_PrimOp Integer2IntOp = ILIT(120)
434 tagOf_PrimOp Integer2WordOp = ILIT(121)
435 tagOf_PrimOp Int2IntegerOp = ILIT(122)
436 tagOf_PrimOp Word2IntegerOp = ILIT(123)
437 tagOf_PrimOp Addr2IntegerOp = ILIT(125)
438 tagOf_PrimOp IntegerToInt64Op = ILIT(127)
439 tagOf_PrimOp Int64ToIntegerOp = ILIT(128)
440 tagOf_PrimOp IntegerToWord64Op = ILIT(129)
441 tagOf_PrimOp Word64ToIntegerOp = ILIT(130)
442 tagOf_PrimOp FloatDecodeOp = ILIT(131)
443 tagOf_PrimOp DoubleDecodeOp = ILIT(132)
444 tagOf_PrimOp NewArrayOp = ILIT(133)
445 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134)
446 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135)
447 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136)
448 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137)
449 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138)
450 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139)
451 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140)
452 tagOf_PrimOp SameMutableArrayOp = ILIT(141)
453 tagOf_PrimOp SameMutableByteArrayOp = ILIT(142)
454 tagOf_PrimOp ReadArrayOp = ILIT(143)
455 tagOf_PrimOp WriteArrayOp = ILIT(144)
456 tagOf_PrimOp IndexArrayOp = ILIT(145)
457 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146)
458 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147)
459 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148)
460 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149)
461 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150)
462 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151)
463 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152)
464 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153)
465 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154)
466 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155)
467 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156)
468 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157)
469 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158)
470 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159)
471 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160)
472 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161)
473 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162)
474 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163)
475 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164)
476 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165)
477 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166)
478 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167)
479 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168)
480 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169)
481 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170)
482 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171)
483 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172)
484 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173)
485 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174)
486 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175)
487 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176)
488 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177)
489 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178)
490 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179)
491 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180)
492 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181)
493 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182)
494 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183)
495 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184)
496 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185)
497 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186)
498 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
499 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
500 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189)
501 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
502 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(191)
503 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(192)
504 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(193)
505 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(194)
506 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(195)
507 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(196)
508 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(197)
509 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(198)
510 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(199)
511 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(200)
512 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(201)
513 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(202)
514 tagOf_PrimOp UnsafeThawArrayOp = ILIT(203)
515 tagOf_PrimOp SizeofByteArrayOp = ILIT(205)
516 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(206)
517 tagOf_PrimOp NewMVarOp = ILIT(207)
518 tagOf_PrimOp TakeMVarOp = ILIT(208)
519 tagOf_PrimOp PutMVarOp = ILIT(209)
520 tagOf_PrimOp SameMVarOp = ILIT(210)
521 tagOf_PrimOp IsEmptyMVarOp = ILIT(211)
522 tagOf_PrimOp MakeForeignObjOp = ILIT(212)
523 tagOf_PrimOp WriteForeignObjOp = ILIT(213)
524 tagOf_PrimOp MkWeakOp = ILIT(214)
525 tagOf_PrimOp DeRefWeakOp = ILIT(215)
526 tagOf_PrimOp FinalizeWeakOp = ILIT(216)
527 tagOf_PrimOp MakeStableNameOp = ILIT(217)
528 tagOf_PrimOp EqStableNameOp = ILIT(218)
529 tagOf_PrimOp StableNameToIntOp = ILIT(219)
530 tagOf_PrimOp MakeStablePtrOp = ILIT(220)
531 tagOf_PrimOp DeRefStablePtrOp = ILIT(221)
532 tagOf_PrimOp EqStablePtrOp = ILIT(222)
533 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(223)
534 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(224)
535 tagOf_PrimOp SeqOp = ILIT(225)
536 tagOf_PrimOp ParOp = ILIT(226)
537 tagOf_PrimOp ForkOp = ILIT(227)
538 tagOf_PrimOp KillThreadOp = ILIT(228)
539 tagOf_PrimOp YieldOp = ILIT(229)
540 tagOf_PrimOp MyThreadIdOp = ILIT(230)
541 tagOf_PrimOp DelayOp = ILIT(231)
542 tagOf_PrimOp WaitReadOp = ILIT(232)
543 tagOf_PrimOp WaitWriteOp = ILIT(233)
544 tagOf_PrimOp ParGlobalOp = ILIT(234)
545 tagOf_PrimOp ParLocalOp = ILIT(235)
546 tagOf_PrimOp ParAtOp = ILIT(236)
547 tagOf_PrimOp ParAtAbsOp = ILIT(237)
548 tagOf_PrimOp ParAtRelOp = ILIT(238)
549 tagOf_PrimOp ParAtForNowOp = ILIT(239)
550 tagOf_PrimOp CopyableOp = ILIT(240)
551 tagOf_PrimOp NoFollowOp = ILIT(241)
552 tagOf_PrimOp NewMutVarOp = ILIT(242)
553 tagOf_PrimOp ReadMutVarOp = ILIT(243)
554 tagOf_PrimOp WriteMutVarOp = ILIT(244)
555 tagOf_PrimOp SameMutVarOp = ILIT(245)
556 tagOf_PrimOp CatchOp = ILIT(246)
557 tagOf_PrimOp RaiseOp = ILIT(247)
558 tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(248)
559 tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(249)
560 tagOf_PrimOp DataToTagOp = ILIT(250)
561 tagOf_PrimOp TagToEnumOp = ILIT(251)
563 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
564 --panic# "tagOf_PrimOp: pattern-match"
566 instance Eq PrimOp where
567 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
569 instance Ord PrimOp where
570 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
571 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
572 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
573 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
574 op1 `compare` op2 | op1 < op2 = LT
578 instance Outputable PrimOp where
579 ppr op = pprPrimOp op
581 instance Show PrimOp where
582 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
585 An @Enum@-derived list would be better; meanwhile... (ToDo)
719 NewByteArrayOp CharRep,
720 NewByteArrayOp IntRep,
721 NewByteArrayOp WordRep,
722 NewByteArrayOp AddrRep,
723 NewByteArrayOp FloatRep,
724 NewByteArrayOp DoubleRep,
725 NewByteArrayOp StablePtrRep,
727 SameMutableByteArrayOp,
731 ReadByteArrayOp CharRep,
732 ReadByteArrayOp IntRep,
733 ReadByteArrayOp WordRep,
734 ReadByteArrayOp AddrRep,
735 ReadByteArrayOp FloatRep,
736 ReadByteArrayOp DoubleRep,
737 ReadByteArrayOp StablePtrRep,
738 ReadByteArrayOp Int64Rep,
739 ReadByteArrayOp Word64Rep,
740 WriteByteArrayOp CharRep,
741 WriteByteArrayOp IntRep,
742 WriteByteArrayOp WordRep,
743 WriteByteArrayOp AddrRep,
744 WriteByteArrayOp FloatRep,
745 WriteByteArrayOp DoubleRep,
746 WriteByteArrayOp StablePtrRep,
747 WriteByteArrayOp Int64Rep,
748 WriteByteArrayOp Word64Rep,
749 IndexByteArrayOp CharRep,
750 IndexByteArrayOp IntRep,
751 IndexByteArrayOp WordRep,
752 IndexByteArrayOp AddrRep,
753 IndexByteArrayOp FloatRep,
754 IndexByteArrayOp DoubleRep,
755 IndexByteArrayOp StablePtrRep,
756 IndexByteArrayOp Int64Rep,
757 IndexByteArrayOp Word64Rep,
758 IndexOffForeignObjOp CharRep,
759 IndexOffForeignObjOp AddrRep,
760 IndexOffForeignObjOp IntRep,
761 IndexOffForeignObjOp WordRep,
762 IndexOffForeignObjOp FloatRep,
763 IndexOffForeignObjOp DoubleRep,
764 IndexOffForeignObjOp StablePtrRep,
765 IndexOffForeignObjOp Int64Rep,
766 IndexOffForeignObjOp Word64Rep,
767 IndexOffAddrOp CharRep,
768 IndexOffAddrOp IntRep,
769 IndexOffAddrOp WordRep,
770 IndexOffAddrOp AddrRep,
771 IndexOffAddrOp FloatRep,
772 IndexOffAddrOp DoubleRep,
773 IndexOffAddrOp StablePtrRep,
774 IndexOffAddrOp Int64Rep,
775 IndexOffAddrOp Word64Rep,
776 WriteOffAddrOp CharRep,
777 WriteOffAddrOp IntRep,
778 WriteOffAddrOp WordRep,
779 WriteOffAddrOp AddrRep,
780 WriteOffAddrOp FloatRep,
781 WriteOffAddrOp DoubleRep,
782 WriteOffAddrOp ForeignObjRep,
783 WriteOffAddrOp StablePtrRep,
784 WriteOffAddrOp Int64Rep,
785 WriteOffAddrOp Word64Rep,
787 UnsafeFreezeByteArrayOp,
790 SizeofMutableByteArrayOp,
797 BlockAsyncExceptionsOp,
798 UnblockAsyncExceptionsOp,
815 ReallyUnsafePtrEqualityOp,
838 %************************************************************************
840 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
842 %************************************************************************
844 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
845 refer to the primitive operation. The conventional \tr{#}-for-
846 unboxed ops is added on later.
848 The reason for the funny characters in the names is so we do not
849 interfere with the programmer's Haskell name spaces.
851 We use @PrimKinds@ for the ``type'' information, because they're
852 (slightly) more convenient to use than @TyCons@.
855 = Dyadic OccName -- string :: T -> T -> T
857 | Monadic OccName -- string :: T -> T
859 | Compare OccName -- string :: T -> T -> Bool
862 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
867 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
868 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
869 mkCompare str ty = Compare (mkSrcVarOcc str) ty
870 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
875 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
877 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
878 intPrimTy, byteArrayPrimTy] -- second '' pieces
879 an_Integer_and_Int_tys
880 = [intPrimTy, byteArrayPrimTy, -- Integer
883 unboxedPair = mkUnboxedTupleTy 2
884 unboxedTriple = mkUnboxedTupleTy 3
885 unboxedQuadruple = mkUnboxedTupleTy 4
887 mkIOTy ty = mkFunTy realWorldStatePrimTy
888 (unboxedPair [realWorldStatePrimTy,ty])
890 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
891 (unboxedPair one_Integer_ty)
893 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
894 (unboxedPair one_Integer_ty)
896 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
897 (unboxedQuadruple two_Integer_tys)
899 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
902 %************************************************************************
904 \subsubsection{Strictness}
906 %************************************************************************
908 Not all primops are strict!
911 primOpStrictness :: PrimOp -> ([Demand], Bool)
912 -- See IdInfo.StrictnessInfo for discussion of what the results
913 -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,
914 -- the list of demands may be infinite!
915 -- Use only the ones you ned.
917 primOpStrictness SeqOp = ([wwStrict], False)
918 -- Seq is strict in its argument; see notes in ConFold.lhs
920 primOpStrictness ParOp = ([wwLazy], False)
921 -- But Par is lazy, to avoid that the sparked thing
922 -- gets evaluted strictly, which it should *not* be
924 primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
926 primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
927 primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
929 primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)
930 primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
932 primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
934 primOpStrictness CatchOp = ([wwLazy, wwLazy, wwPrim], False)
935 primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
936 primOpStrictness BlockAsyncExceptionsOp = ([wwLazy], False)
937 primOpStrictness UnblockAsyncExceptionsOp = ([wwLazy], False)
939 primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
940 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
941 primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
943 primOpStrictness DataToTagOp = ([wwLazy], False)
945 -- The rest all have primitive-typed arguments
946 primOpStrictness other = (repeat wwPrim, False)
949 %************************************************************************
951 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
953 %************************************************************************
955 @primOpInfo@ gives all essential information (from which everything
956 else, notably a type, can be constructed) for each @PrimOp@.
959 primOpInfo :: PrimOp -> PrimOpInfo
962 There's plenty of this stuff!
965 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
966 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
967 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
968 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
969 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
970 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
972 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
973 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
974 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
975 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
976 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
977 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
979 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
980 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
981 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
982 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
983 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
984 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
986 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
987 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
988 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
989 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
990 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
991 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
993 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
994 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
995 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
996 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
997 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
998 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
1000 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
1001 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
1002 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
1003 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
1004 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
1005 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
1009 %************************************************************************
1011 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
1013 %************************************************************************
1016 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
1017 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
1020 %************************************************************************
1022 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
1024 %************************************************************************
1027 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
1028 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
1029 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
1030 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
1031 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
1032 primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
1034 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
1036 primOpInfo IntAddCOp =
1037 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
1038 (unboxedPair [intPrimTy, intPrimTy])
1040 primOpInfo IntSubCOp =
1041 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
1042 (unboxedPair [intPrimTy, intPrimTy])
1044 primOpInfo IntMulCOp =
1045 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
1046 (unboxedPair [intPrimTy, intPrimTy])
1049 %************************************************************************
1051 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1053 %************************************************************************
1055 A @Word#@ is an unsigned @Int#@.
1058 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1059 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1061 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1062 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1063 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1064 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1067 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1069 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1072 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1074 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1076 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1078 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1079 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1082 %************************************************************************
1084 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1086 %************************************************************************
1089 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1090 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1094 %************************************************************************
1096 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1098 %************************************************************************
1100 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1103 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1104 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1105 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1106 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1107 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1109 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1110 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1112 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1113 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1114 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1115 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1116 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1117 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1118 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1119 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1120 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1121 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1122 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1123 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1124 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1127 %************************************************************************
1129 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1131 %************************************************************************
1133 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1136 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1137 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1138 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1139 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1140 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1142 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1143 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1145 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1146 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1148 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1149 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1150 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1151 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1152 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1153 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1154 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1155 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1156 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1157 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1158 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1159 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1160 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1163 %************************************************************************
1165 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1167 %************************************************************************
1170 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1172 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1173 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1174 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1175 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1176 primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1177 primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
1178 primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
1179 primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
1181 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1182 primOpInfo IntegerCmpIntOp
1183 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1185 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1186 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1188 primOpInfo Integer2IntOp
1189 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1191 primOpInfo Integer2WordOp
1192 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1194 primOpInfo Int2IntegerOp
1195 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1196 (unboxedPair one_Integer_ty)
1198 primOpInfo Word2IntegerOp
1199 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1200 (unboxedPair one_Integer_ty)
1202 primOpInfo Addr2IntegerOp
1203 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1204 (unboxedPair one_Integer_ty)
1206 primOpInfo IntegerToInt64Op
1207 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1209 primOpInfo Int64ToIntegerOp
1210 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1211 (unboxedPair one_Integer_ty)
1213 primOpInfo Word64ToIntegerOp
1214 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1215 (unboxedPair one_Integer_ty)
1217 primOpInfo IntegerToWord64Op
1218 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1221 Decoding of floating-point numbers is sorta Integer-related. Encoding
1222 is done with plain ccalls now (see PrelNumExtra.lhs).
1225 primOpInfo FloatDecodeOp
1226 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1227 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1228 primOpInfo DoubleDecodeOp
1229 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1230 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1233 %************************************************************************
1235 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1237 %************************************************************************
1240 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1241 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1245 primOpInfo NewArrayOp
1247 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1248 state = mkStatePrimTy s
1250 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1251 [intPrimTy, elt, state]
1252 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1254 primOpInfo (NewByteArrayOp kind)
1256 s = alphaTy; s_tv = alphaTyVar
1258 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1259 state = mkStatePrimTy s
1261 mkGenPrimOp op_str [s_tv]
1263 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1265 ---------------------------------------------------------------------------
1268 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1269 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1272 primOpInfo SameMutableArrayOp
1274 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1275 mut_arr_ty = mkMutableArrayPrimTy s elt
1277 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1280 primOpInfo SameMutableByteArrayOp
1282 s = alphaTy; s_tv = alphaTyVar;
1283 mut_arr_ty = mkMutableByteArrayPrimTy s
1285 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1288 ---------------------------------------------------------------------------
1289 -- Primitive arrays of Haskell pointers:
1292 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1293 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1294 indexArray# :: Array# a -> Int# -> (# a #)
1297 primOpInfo ReadArrayOp
1299 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1300 state = mkStatePrimTy s
1302 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1303 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1304 (unboxedPair [state, elt])
1307 primOpInfo WriteArrayOp
1309 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1311 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1312 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1315 primOpInfo IndexArrayOp
1316 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1317 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1318 (mkUnboxedTupleTy 1 [elt])
1320 ---------------------------------------------------------------------------
1321 -- Primitive arrays full of unboxed bytes:
1323 primOpInfo (ReadByteArrayOp kind)
1325 s = alphaTy; s_tv = alphaTyVar
1327 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1328 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1329 state = mkStatePrimTy s
1331 mkGenPrimOp op_str (s_tv:tvs)
1332 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1333 (unboxedPair [state, prim_ty])
1335 primOpInfo (WriteByteArrayOp kind)
1337 s = alphaTy; s_tv = alphaTyVar
1338 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1339 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1341 mkGenPrimOp op_str (s_tv:tvs)
1342 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1345 primOpInfo (IndexByteArrayOp kind)
1347 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1348 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1350 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1352 primOpInfo (IndexOffForeignObjOp kind)
1354 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1355 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1357 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1359 primOpInfo (IndexOffAddrOp kind)
1361 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1362 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1364 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1366 primOpInfo (WriteOffAddrOp kind)
1368 s = alphaTy; s_tv = alphaTyVar
1369 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1370 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1372 mkGenPrimOp op_str (s_tv:tvs)
1373 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1376 ---------------------------------------------------------------------------
1378 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1379 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1380 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1383 primOpInfo UnsafeFreezeArrayOp
1385 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1386 state = mkStatePrimTy s
1388 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1389 [mkMutableArrayPrimTy s elt, state]
1390 (unboxedPair [state, mkArrayPrimTy elt])
1392 primOpInfo UnsafeFreezeByteArrayOp
1394 s = alphaTy; s_tv = alphaTyVar;
1395 state = mkStatePrimTy s
1397 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1398 [mkMutableByteArrayPrimTy s, state]
1399 (unboxedPair [state, byteArrayPrimTy])
1401 primOpInfo UnsafeThawArrayOp
1403 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1404 state = mkStatePrimTy s
1406 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
1407 [mkArrayPrimTy elt, state]
1408 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1410 ---------------------------------------------------------------------------
1411 primOpInfo SizeofByteArrayOp
1413 SLIT("sizeofByteArray#") []
1417 primOpInfo SizeofMutableByteArrayOp
1418 = let { s = alphaTy; s_tv = alphaTyVar } in
1420 SLIT("sizeofMutableByteArray#") [s_tv]
1421 [mkMutableByteArrayPrimTy s]
1426 %************************************************************************
1428 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1430 %************************************************************************
1433 primOpInfo NewMutVarOp
1435 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1436 state = mkStatePrimTy s
1438 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1440 (unboxedPair [state, mkMutVarPrimTy s elt])
1442 primOpInfo ReadMutVarOp
1444 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1445 state = mkStatePrimTy s
1447 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1448 [mkMutVarPrimTy s elt, state]
1449 (unboxedPair [state, elt])
1452 primOpInfo WriteMutVarOp
1454 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1456 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1457 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1460 primOpInfo SameMutVarOp
1462 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1463 mut_var_ty = mkMutVarPrimTy s elt
1465 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1469 %************************************************************************
1471 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1473 %************************************************************************
1475 catch# :: (State# RealWorld -> (# State# RealWorld, a))
1476 -> (b -> State# RealWorld -> (# State# RealWorld, a))
1478 -> (# State# RealWorld, a)
1480 throw :: Exception -> a
1483 blockAsyncExceptions# :: IO a -> IO a
1484 unblockAsyncExceptions# :: IO a -> IO a
1489 a = alphaTy; a_tv = alphaTyVar
1490 b = betaTy; b_tv = betaTyVar;
1493 mkGenPrimOp SLIT("catch#") [a_tv, b_tv]
1494 [io_a, mkFunTy b io_a, realWorldStatePrimTy]
1495 (unboxedPair [realWorldStatePrimTy, a])
1499 a = alphaTy; a_tv = alphaTyVar
1500 b = betaTy; b_tv = betaTyVar;
1502 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1504 primOpInfo BlockAsyncExceptionsOp
1506 a = alphaTy; a_tv = alphaTyVar
1508 mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
1509 [ mkIOTy a, realWorldStatePrimTy ]
1510 (unboxedPair [realWorldStatePrimTy,a])
1512 primOpInfo UnblockAsyncExceptionsOp
1514 a = alphaTy; a_tv = alphaTyVar
1516 mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
1517 [ mkIOTy a, realWorldStatePrimTy ]
1518 (unboxedPair [realWorldStatePrimTy,a])
1521 %************************************************************************
1523 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1525 %************************************************************************
1528 primOpInfo NewMVarOp
1530 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1531 state = mkStatePrimTy s
1533 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1534 (unboxedPair [state, mkMVarPrimTy s elt])
1536 primOpInfo TakeMVarOp
1538 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1539 state = mkStatePrimTy s
1541 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1542 [mkMVarPrimTy s elt, state]
1543 (unboxedPair [state, elt])
1545 primOpInfo PutMVarOp
1547 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1549 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1550 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1553 primOpInfo SameMVarOp
1555 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1556 mvar_ty = mkMVarPrimTy s elt
1558 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1560 primOpInfo IsEmptyMVarOp
1562 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1563 state = mkStatePrimTy s
1565 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1566 [mkMVarPrimTy s elt, mkStatePrimTy s]
1567 (unboxedPair [state, intPrimTy])
1571 %************************************************************************
1573 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1575 %************************************************************************
1581 s = alphaTy; s_tv = alphaTyVar
1583 mkGenPrimOp SLIT("delay#") [s_tv]
1584 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1586 primOpInfo WaitReadOp
1588 s = alphaTy; s_tv = alphaTyVar
1590 mkGenPrimOp SLIT("waitRead#") [s_tv]
1591 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1593 primOpInfo WaitWriteOp
1595 s = alphaTy; s_tv = alphaTyVar
1597 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1598 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1601 %************************************************************************
1603 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1605 %************************************************************************
1608 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1610 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1611 [alphaTy, realWorldStatePrimTy]
1612 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1614 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1615 primOpInfo KillThreadOp
1616 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1617 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1618 realWorldStatePrimTy
1620 -- yield# :: State# RealWorld -> State# RealWorld
1622 = mkGenPrimOp SLIT("yield#") []
1623 [realWorldStatePrimTy]
1624 realWorldStatePrimTy
1626 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1627 primOpInfo MyThreadIdOp
1628 = mkGenPrimOp SLIT("myThreadId#") []
1629 [realWorldStatePrimTy]
1630 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1633 ************************************************************************
1635 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1637 %************************************************************************
1640 primOpInfo MakeForeignObjOp
1641 = mkGenPrimOp SLIT("makeForeignObj#") []
1642 [addrPrimTy, realWorldStatePrimTy]
1643 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1645 primOpInfo WriteForeignObjOp
1647 s = alphaTy; s_tv = alphaTyVar
1649 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1650 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1653 ************************************************************************
1655 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1657 %************************************************************************
1659 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1661 mkWeak# :: k -> v -> f -> State# RealWorld
1662 -> (# State# RealWorld, Weak# v #)
1664 In practice, you'll use the higher-level
1666 data Weak v = Weak# v
1667 mkWeak :: k -> v -> IO () -> IO (Weak v)
1671 = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
1672 [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
1673 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1676 The following operation dereferences a weak pointer. The weak pointer
1677 may have been finalized, so the operation returns a result code which
1678 must be inspected before looking at the dereferenced value.
1680 deRefWeak# :: Weak# v -> State# RealWorld ->
1681 (# State# RealWorld, v, Int# #)
1683 Only look at v if the Int# returned is /= 0 !!
1685 The higher-level op is
1687 deRefWeak :: Weak v -> IO (Maybe v)
1690 primOpInfo DeRefWeakOp
1691 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1692 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1693 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1696 Weak pointers can be finalized early by using the finalize# operation:
1698 finalizeWeak# :: Weak# v -> State# RealWorld ->
1699 (# State# RealWorld, Int#, IO () #)
1701 The Int# returned is either
1703 0 if the weak pointer has already been finalized, or it has no
1704 finalizer (the third component is then invalid).
1706 1 if the weak pointer is still alive, with the finalizer returned
1707 as the third component.
1710 primOpInfo FinalizeWeakOp
1711 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1712 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1713 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1714 mkFunTy realWorldStatePrimTy
1715 (unboxedPair [realWorldStatePrimTy,unitTy])])
1718 %************************************************************************
1720 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1722 %************************************************************************
1724 A {\em stable name/pointer} is an index into a table of stable name
1725 entries. Since the garbage collector is told about stable pointers,
1726 it is safe to pass a stable pointer to external systems such as C
1730 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1731 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1732 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1733 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1736 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1737 operation since it doesn't (directly) involve IO operations. The
1738 reason is that if some optimisation pass decided to duplicate calls to
1739 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1740 massive space leak can result. Putting it into the IO monad
1741 prevents this. (Another reason for putting them in a monad is to
1742 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1745 An important property of stable pointers is that if you call
1746 makeStablePtr# twice on the same object you get the same stable
1749 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1750 besides, it's not likely to be used from Haskell) so it's not a
1753 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1758 A stable name is like a stable pointer, but with three important differences:
1760 (a) You can't deRef one to get back to the original object.
1761 (b) You can convert one to an Int.
1762 (c) You don't need to 'freeStableName'
1764 The existence of a stable name doesn't guarantee to keep the object it
1765 points to alive (unlike a stable pointer), hence (a).
1769 (a) makeStableName always returns the same value for a given
1770 object (same as stable pointers).
1772 (b) if two stable names are equal, it implies that the objects
1773 from which they were created were the same.
1775 (c) stableNameToInt always returns the same Int for a given
1779 primOpInfo MakeStablePtrOp
1780 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1781 [alphaTy, realWorldStatePrimTy]
1782 (unboxedPair [realWorldStatePrimTy,
1783 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1785 primOpInfo DeRefStablePtrOp
1786 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1787 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1788 (unboxedPair [realWorldStatePrimTy, alphaTy])
1790 primOpInfo EqStablePtrOp
1791 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1792 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1795 primOpInfo MakeStableNameOp
1796 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1797 [alphaTy, realWorldStatePrimTy]
1798 (unboxedPair [realWorldStatePrimTy,
1799 mkTyConApp stableNamePrimTyCon [alphaTy]])
1801 primOpInfo EqStableNameOp
1802 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1803 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1806 primOpInfo StableNameToIntOp
1807 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1808 [mkStableNamePrimTy alphaTy]
1812 %************************************************************************
1814 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1816 %************************************************************************
1818 [Alastair Reid is to blame for this!]
1820 These days, (Glasgow) Haskell seems to have a bit of everything from
1821 other languages: strict operations, mutable variables, sequencing,
1822 pointers, etc. About the only thing left is LISP's ability to test
1823 for pointer equality. So, let's add it in!
1826 reallyUnsafePtrEquality :: a -> a -> Int#
1829 which tests any two closures (of the same type) to see if they're the
1830 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1831 difficulties of trying to box up the result.)
1833 NB This is {\em really unsafe\/} because even something as trivial as
1834 a garbage collection might change the answer by removing indirections.
1835 Still, no-one's forcing you to use it. If you're worried about little
1836 things like loss of referential transparency, you might like to wrap
1837 it all up in a monad-like thing as John O'Donnell and John Hughes did
1838 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1841 I'm thinking of using it to speed up a critical equality test in some
1842 graphics stuff in a context where the possibility of saying that
1843 denotationally equal things aren't isn't a problem (as long as it
1844 doesn't happen too often.) ADR
1846 To Will: Jim said this was already in, but I can't see it so I'm
1847 adding it. Up to you whether you add it. (Note that this could have
1848 been readily implemented using a @veryDangerousCCall@ before they were
1852 primOpInfo ReallyUnsafePtrEqualityOp
1853 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1854 [alphaTy, alphaTy] intPrimTy
1857 %************************************************************************
1859 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1861 %************************************************************************
1864 primOpInfo SeqOp -- seq# :: a -> Int#
1865 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1867 primOpInfo ParOp -- par# :: a -> Int#
1868 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1872 -- HWL: The first 4 Int# in all par... annotations denote:
1873 -- name, granularity info, size of result, degree of parallelism
1874 -- Same structure as _seq_ i.e. returns Int#
1875 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1876 -- `the processor containing the expression v'; it is not evaluated
1878 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1879 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1881 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1882 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1884 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1885 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1887 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1888 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1890 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1891 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1893 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1894 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1896 primOpInfo CopyableOp -- copyable# :: a -> Int#
1897 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1899 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1900 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1903 %************************************************************************
1905 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1907 %************************************************************************
1910 primOpInfo (CCallOp _ _ _ _)
1911 = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
1914 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1915 = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
1917 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1921 %************************************************************************
1923 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1925 %************************************************************************
1927 These primops are pretty wierd.
1929 dataToTag# :: a -> Int (arg must be an evaluated data type)
1930 tagToEnum# :: Int -> a (result type must be an enumerated type)
1932 The constraints aren't currently checked by the front end, but the
1933 code generator will fall over if they aren't satisfied.
1936 primOpInfo DataToTagOp
1937 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1939 primOpInfo TagToEnumOp
1940 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1943 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1947 %************************************************************************
1949 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1951 %************************************************************************
1953 Some PrimOps need to be called out-of-line because they either need to
1954 perform a heap check or they block.
1966 BlockAsyncExceptionsOp -> True
1967 UnblockAsyncExceptionsOp -> True
1969 NewByteArrayOp _ -> True
1970 IntegerAddOp -> True
1971 IntegerSubOp -> True
1972 IntegerMulOp -> True
1973 IntegerGcdOp -> True
1974 IntegerDivExactOp -> True
1975 IntegerQuotOp -> True
1976 IntegerRemOp -> True
1977 IntegerQuotRemOp -> True
1978 IntegerDivModOp -> True
1979 Int2IntegerOp -> True
1980 Word2IntegerOp -> True
1981 Addr2IntegerOp -> True
1982 Word64ToIntegerOp -> True
1983 Int64ToIntegerOp -> True
1984 FloatDecodeOp -> True
1985 DoubleDecodeOp -> True
1987 FinalizeWeakOp -> True
1988 MakeStableNameOp -> True
1989 MakeForeignObjOp -> True
1993 KillThreadOp -> True
1995 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
1996 -- the next one doesn't perform any heap checks,
1997 -- but it is of such an esoteric nature that
1998 -- it is done out-of-line rather than require
1999 -- the NCG to implement it.
2000 UnsafeThawArrayOp -> True
2005 primOpOkForSpeculation
2006 ~~~~~~~~~~~~~~~~~~~~~~
2007 Sometimes we may choose to execute a PrimOp even though it isn't
2008 certain that its result will be required; ie execute them
2009 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
2010 this is OK, because PrimOps are usually cheap, but it isn't OK for
2011 (a)~expensive PrimOps and (b)~PrimOps which can fail.
2013 PrimOps that have side effects also should not be executed speculatively.
2015 Ok-for-speculation also means that it's ok *not* to execute the
2019 Here the result is not used, so we can discard the primop. Anything
2020 that has side effects mustn't be dicarded in this way, of course!
2022 See also @primOpIsCheap@ (below).
2026 primOpOkForSpeculation :: PrimOp -> Bool
2027 -- See comments with CoreUtils.exprOkForSpeculation
2028 primOpOkForSpeculation op
2029 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
2035 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
2036 WARNING), we just borrow some other predicates for a
2037 what-should-be-good-enough test. "Cheap" means willing to call it more
2038 than once. Evaluation order is unaffected.
2041 primOpIsCheap :: PrimOp -> Bool
2042 -- See comments with CoreUtils.exprOkForSpeculation
2043 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
2048 primOpIsDupable means that the use of the primop is small enough to
2049 duplicate into different case branches. See CoreUtils.exprIsDupable.
2052 primOpIsDupable :: PrimOp -> Bool
2053 -- See comments with CoreUtils.exprIsDupable
2054 primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc
2055 -- If the ccall can't GC then the call is pretty cheap, and
2056 -- we're happy to duplicate
2057 primOpIsDupable op = not (primOpOutOfLine op)
2062 primOpCanFail :: PrimOp -> Bool
2064 primOpCanFail IntQuotOp = True -- Divide by zero
2065 primOpCanFail IntRemOp = True -- Divide by zero
2068 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2069 primOpCanFail IntegerDivModOp = True -- Divide by zero
2071 -- Float. ToDo: tan? tanh?
2072 primOpCanFail FloatDivOp = True -- Divide by zero
2073 primOpCanFail FloatLogOp = True -- Log of zero
2074 primOpCanFail FloatAsinOp = True -- Arg out of domain
2075 primOpCanFail FloatAcosOp = True -- Arg out of domain
2077 -- Double. ToDo: tan? tanh?
2078 primOpCanFail DoubleDivOp = True -- Divide by zero
2079 primOpCanFail DoubleLogOp = True -- Log of zero
2080 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2081 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2083 primOpCanFail other_op = False
2086 And some primops have side-effects and so, for example, must not be
2090 primOpHasSideEffects :: PrimOp -> Bool
2092 primOpHasSideEffects ParOp = True
2093 primOpHasSideEffects ForkOp = True
2094 primOpHasSideEffects KillThreadOp = True
2095 primOpHasSideEffects YieldOp = True
2096 primOpHasSideEffects SeqOp = True
2098 primOpHasSideEffects MakeForeignObjOp = True
2099 primOpHasSideEffects WriteForeignObjOp = True
2100 primOpHasSideEffects MkWeakOp = True
2101 primOpHasSideEffects DeRefWeakOp = True
2102 primOpHasSideEffects FinalizeWeakOp = True
2103 primOpHasSideEffects MakeStablePtrOp = True
2104 primOpHasSideEffects MakeStableNameOp = True
2105 primOpHasSideEffects EqStablePtrOp = True -- SOF
2106 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2108 -- In general, writes are considered a side effect, but
2109 -- reads and variable allocations are not
2110 -- Why? Because writes must not be omitted, but reads can be if their result is not used.
2111 -- (Sequencing of reads is maintained by data dependencies on the resulting
2113 primOpHasSideEffects WriteArrayOp = True
2114 primOpHasSideEffects (WriteByteArrayOp _) = True
2115 primOpHasSideEffects (WriteOffAddrOp _) = True
2116 primOpHasSideEffects WriteMutVarOp = True
2118 primOpHasSideEffects UnsafeFreezeArrayOp = True
2119 primOpHasSideEffects UnsafeFreezeByteArrayOp = True
2120 primOpHasSideEffects UnsafeThawArrayOp = True
2122 primOpHasSideEffects TakeMVarOp = True
2123 primOpHasSideEffects PutMVarOp = True
2124 primOpHasSideEffects DelayOp = True
2125 primOpHasSideEffects WaitReadOp = True
2126 primOpHasSideEffects WaitWriteOp = True
2128 primOpHasSideEffects ParGlobalOp = True
2129 primOpHasSideEffects ParLocalOp = True
2130 primOpHasSideEffects ParAtOp = True
2131 primOpHasSideEffects ParAtAbsOp = True
2132 primOpHasSideEffects ParAtRelOp = True
2133 primOpHasSideEffects ParAtForNowOp = True
2134 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2135 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2138 primOpHasSideEffects (CCallOp _ _ _ _) = True
2140 primOpHasSideEffects other = False
2143 Inline primitive operations that perform calls need wrappers to save
2144 any live variables that are stored in caller-saves registers.
2147 primOpNeedsWrapper :: PrimOp -> Bool
2149 primOpNeedsWrapper (CCallOp _ _ _ _) = True
2151 primOpNeedsWrapper Integer2IntOp = True
2152 primOpNeedsWrapper Integer2WordOp = True
2153 primOpNeedsWrapper IntegerCmpOp = True
2154 primOpNeedsWrapper IntegerCmpIntOp = True
2156 primOpNeedsWrapper FloatExpOp = True
2157 primOpNeedsWrapper FloatLogOp = True
2158 primOpNeedsWrapper FloatSqrtOp = True
2159 primOpNeedsWrapper FloatSinOp = True
2160 primOpNeedsWrapper FloatCosOp = True
2161 primOpNeedsWrapper FloatTanOp = True
2162 primOpNeedsWrapper FloatAsinOp = True
2163 primOpNeedsWrapper FloatAcosOp = True
2164 primOpNeedsWrapper FloatAtanOp = True
2165 primOpNeedsWrapper FloatSinhOp = True
2166 primOpNeedsWrapper FloatCoshOp = True
2167 primOpNeedsWrapper FloatTanhOp = True
2168 primOpNeedsWrapper FloatPowerOp = True
2170 primOpNeedsWrapper DoubleExpOp = True
2171 primOpNeedsWrapper DoubleLogOp = True
2172 primOpNeedsWrapper DoubleSqrtOp = True
2173 primOpNeedsWrapper DoubleSinOp = True
2174 primOpNeedsWrapper DoubleCosOp = True
2175 primOpNeedsWrapper DoubleTanOp = True
2176 primOpNeedsWrapper DoubleAsinOp = True
2177 primOpNeedsWrapper DoubleAcosOp = True
2178 primOpNeedsWrapper DoubleAtanOp = True
2179 primOpNeedsWrapper DoubleSinhOp = True
2180 primOpNeedsWrapper DoubleCoshOp = True
2181 primOpNeedsWrapper DoubleTanhOp = True
2182 primOpNeedsWrapper DoublePowerOp = True
2184 primOpNeedsWrapper MakeStableNameOp = True
2185 primOpNeedsWrapper DeRefStablePtrOp = True
2187 primOpNeedsWrapper DelayOp = True
2188 primOpNeedsWrapper WaitReadOp = True
2189 primOpNeedsWrapper WaitWriteOp = True
2191 primOpNeedsWrapper other_op = False
2195 primOpArity :: PrimOp -> Arity
2197 = case (primOpInfo op) of
2201 GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
2203 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2205 = case (primOpInfo op) of
2206 Dyadic occ ty -> dyadic_fun_ty ty
2207 Monadic occ ty -> monadic_fun_ty ty
2208 Compare occ ty -> compare_fun_ty ty
2210 GenPrimOp occ tyvars arg_tys res_ty ->
2211 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2213 mkPrimOpIdName :: PrimOp -> Id -> Name
2214 -- Make the name for the PrimOp's Id
2215 -- We have to pass in the Id itself because it's a WiredInId
2216 -- and hence recursive
2217 mkPrimOpIdName op id
2218 = mkWiredInIdName key pREL_GHC occ_name id
2220 occ_name = primOpOcc op
2221 key = mkPrimOpIdUnique (primOpTag op)
2224 primOpRdrName :: PrimOp -> RdrName
2225 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2227 primOpOcc :: PrimOp -> OccName
2228 primOpOcc op = case (primOpInfo op) of
2230 Monadic occ _ -> occ
2231 Compare occ _ -> occ
2232 GenPrimOp occ _ _ _ -> occ
2234 -- primOpSig is like primOpType but gives the result split apart:
2235 -- (type variables, argument types, result type)
2237 primOpSig :: PrimOp -> ([TyVar],[Type],Type)
2239 = case (primOpInfo op) of
2240 Monadic occ ty -> ([], [ty], ty )
2241 Dyadic occ ty -> ([], [ty,ty], ty )
2242 Compare occ ty -> ([], [ty,ty], boolTy)
2243 GenPrimOp occ tyvars arg_tys res_ty
2244 -> (tyvars, arg_tys, res_ty)
2246 -- primOpUsg is like primOpSig but the types it yields are the
2247 -- appropriate sigma (i.e., usage-annotated) types,
2248 -- as required by the UsageSP inference.
2250 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2254 -- Refer to comment by `otherwise' clause; we need consider here
2255 -- *only* primops that have arguments or results containing Haskell
2256 -- pointers (things that are pointed). Unpointed values are
2257 -- irrelevant to the usage analysis. The issue is whether pointed
2258 -- values may be entered or duplicated by the primop.
2260 -- Remember that primops are *never* partially applied.
2262 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2263 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2264 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2265 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2266 IndexArrayOp -> mangle [mkM, mkP ] mkM
2267 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2268 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2270 NewMutVarOp -> mangle [mkM, mkP ] mkM
2271 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2272 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2273 SameMutVarOp -> mangle [mkP, mkP ] mkM
2275 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2276 mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM
2277 -- might use caught action multiply
2278 RaiseOp -> mangle [mkM ] mkM
2280 NewMVarOp -> mangle [mkP ] mkR
2281 TakeMVarOp -> mangle [mkM, mkP ] mkM
2282 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2283 SameMVarOp -> mangle [mkP, mkP ] mkM
2284 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2286 ForkOp -> mangle [mkO, mkP ] mkR
2287 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2289 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2290 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2291 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2293 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2294 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2295 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2296 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2297 EqStableNameOp -> mangle [mkP, mkP ] mkR
2298 StableNameToIntOp -> mangle [mkP ] mkR
2300 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2302 SeqOp -> mangle [mkO ] mkR
2303 ParOp -> mangle [mkO ] mkR
2304 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2305 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2306 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2307 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2308 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2309 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2310 CopyableOp -> mangle [mkZ ] mkR
2311 NoFollowOp -> mangle [mkZ ] mkR
2313 CCallOp _ _ _ _ -> mangle [ ] mkM
2315 -- Things with no Haskell pointers inside: in actuality, usages are
2316 -- irrelevant here (hence it doesn't matter that some of these
2317 -- apparently permit duplication; since such arguments are never
2318 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2319 -- except insofar as it propagates to infect other values that *are*
2322 otherwise -> nomangle
2324 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2325 mkO = mkUsgTy UsOnce -- pointed argument used once
2326 mkM = mkUsgTy UsMany -- pointed argument used multiply
2327 mkP = mkUsgTy UsOnce -- unpointed argument
2328 mkR = mkUsgTy UsMany -- unpointed result
2330 (tyvars, arg_tys, res_ty)
2333 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2335 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2337 inFun f g ty = case splitFunTy_maybe ty of
2338 Just (a,b) -> mkFunTy (f a) (g b)
2339 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2341 inUB fs ty = case splitTyConApp_maybe ty of
2342 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
2343 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
2345 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2349 data PrimOpResultInfo
2350 = ReturnsPrim PrimRep
2353 -- Some PrimOps need not return a manifest primitive or algebraic value
2354 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2355 -- be out of line, or the code generator won't work.
2357 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2358 getPrimOpResultInfo op
2359 = case (primOpInfo op) of
2360 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2361 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2362 Compare _ ty -> ReturnsAlg boolTyCon
2363 GenPrimOp _ _ _ ty ->
2364 let rep = typePrimRep ty in
2366 PtrRep -> case splitAlgTyConApp_maybe ty of
2367 Nothing -> panic "getPrimOpResultInfo"
2368 Just (tc,_,_) -> ReturnsAlg tc
2369 other -> ReturnsPrim other
2371 isCompareOp :: PrimOp -> Bool
2373 = case primOpInfo op of
2378 The commutable ops are those for which we will try to move constants
2379 to the right hand side for strength reduction.
2382 commutableOp :: PrimOp -> Bool
2384 commutableOp CharEqOp = True
2385 commutableOp CharNeOp = True
2386 commutableOp IntAddOp = True
2387 commutableOp IntMulOp = True
2388 commutableOp AndOp = True
2389 commutableOp OrOp = True
2390 commutableOp XorOp = True
2391 commutableOp IntEqOp = True
2392 commutableOp IntNeOp = True
2393 commutableOp IntegerAddOp = True
2394 commutableOp IntegerMulOp = True
2395 commutableOp IntegerGcdOp = True
2396 commutableOp IntegerIntGcdOp = True
2397 commutableOp FloatAddOp = True
2398 commutableOp FloatMulOp = True
2399 commutableOp FloatEqOp = True
2400 commutableOp FloatNeOp = True
2401 commutableOp DoubleAddOp = True
2402 commutableOp DoubleMulOp = True
2403 commutableOp DoubleEqOp = True
2404 commutableOp DoubleNeOp = True
2405 commutableOp _ = False
2410 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2411 -- CharRep --> ([], Char#)
2412 -- StablePtrRep --> ([a], StablePtr# a)
2413 mkPrimTyApp tvs kind
2414 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2416 tycon = primRepTyCon kind
2417 forall_tvs = take (tyConArity tycon) tvs
2419 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2420 monadic_fun_ty ty = mkFunTy ty ty
2421 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2426 pprPrimOp :: PrimOp -> SDoc
2428 pprPrimOp (CCallOp fun is_casm may_gc cconv)
2430 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2433 | is_casm && may_gc = "casm_GC ``"
2434 | is_casm = "casm ``"
2435 | may_gc = "ccall_GC "
2436 | otherwise = "ccall "
2439 | is_casm = text "''"
2444 Right _ -> text "dyn_"
2449 Right _ -> text "\"\""
2453 hcat [ ifPprDebug callconv
2454 , text "__", ppr_dyn
2455 , text before , ppr_fun , after]
2458 = getPprStyle $ \ sty ->
2459 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2460 ptext SLIT("PrelGHC.") <> pprOccName occ
2464 occ = primOpOcc other_op