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
160 | UnsafeThawArrayOp | UnsafeThawByteArrayOp
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 UnsafeThawByteArrayOp = ILIT(204)
516 tagOf_PrimOp SizeofByteArrayOp = ILIT(205)
517 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(206)
518 tagOf_PrimOp NewMVarOp = ILIT(207)
519 tagOf_PrimOp TakeMVarOp = ILIT(208)
520 tagOf_PrimOp PutMVarOp = ILIT(209)
521 tagOf_PrimOp SameMVarOp = ILIT(210)
522 tagOf_PrimOp IsEmptyMVarOp = ILIT(211)
523 tagOf_PrimOp MakeForeignObjOp = ILIT(212)
524 tagOf_PrimOp WriteForeignObjOp = ILIT(213)
525 tagOf_PrimOp MkWeakOp = ILIT(214)
526 tagOf_PrimOp DeRefWeakOp = ILIT(215)
527 tagOf_PrimOp FinalizeWeakOp = ILIT(216)
528 tagOf_PrimOp MakeStableNameOp = ILIT(217)
529 tagOf_PrimOp EqStableNameOp = ILIT(218)
530 tagOf_PrimOp StableNameToIntOp = ILIT(219)
531 tagOf_PrimOp MakeStablePtrOp = ILIT(220)
532 tagOf_PrimOp DeRefStablePtrOp = ILIT(221)
533 tagOf_PrimOp EqStablePtrOp = ILIT(222)
534 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(223)
535 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(224)
536 tagOf_PrimOp SeqOp = ILIT(225)
537 tagOf_PrimOp ParOp = ILIT(226)
538 tagOf_PrimOp ForkOp = ILIT(227)
539 tagOf_PrimOp KillThreadOp = ILIT(228)
540 tagOf_PrimOp YieldOp = ILIT(229)
541 tagOf_PrimOp MyThreadIdOp = ILIT(230)
542 tagOf_PrimOp DelayOp = ILIT(231)
543 tagOf_PrimOp WaitReadOp = ILIT(232)
544 tagOf_PrimOp WaitWriteOp = ILIT(233)
545 tagOf_PrimOp ParGlobalOp = ILIT(234)
546 tagOf_PrimOp ParLocalOp = ILIT(235)
547 tagOf_PrimOp ParAtOp = ILIT(236)
548 tagOf_PrimOp ParAtAbsOp = ILIT(237)
549 tagOf_PrimOp ParAtRelOp = ILIT(238)
550 tagOf_PrimOp ParAtForNowOp = ILIT(239)
551 tagOf_PrimOp CopyableOp = ILIT(240)
552 tagOf_PrimOp NoFollowOp = ILIT(241)
553 tagOf_PrimOp NewMutVarOp = ILIT(242)
554 tagOf_PrimOp ReadMutVarOp = ILIT(243)
555 tagOf_PrimOp WriteMutVarOp = ILIT(244)
556 tagOf_PrimOp SameMutVarOp = ILIT(245)
557 tagOf_PrimOp CatchOp = ILIT(246)
558 tagOf_PrimOp RaiseOp = ILIT(247)
559 tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(248)
560 tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(249)
561 tagOf_PrimOp DataToTagOp = ILIT(250)
562 tagOf_PrimOp TagToEnumOp = ILIT(251)
564 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
565 --panic# "tagOf_PrimOp: pattern-match"
567 instance Eq PrimOp where
568 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
570 instance Ord PrimOp where
571 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
572 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
573 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
574 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
575 op1 `compare` op2 | op1 < op2 = LT
579 instance Outputable PrimOp where
580 ppr op = pprPrimOp op
582 instance Show PrimOp where
583 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
586 An @Enum@-derived list would be better; meanwhile... (ToDo)
720 NewByteArrayOp CharRep,
721 NewByteArrayOp IntRep,
722 NewByteArrayOp WordRep,
723 NewByteArrayOp AddrRep,
724 NewByteArrayOp FloatRep,
725 NewByteArrayOp DoubleRep,
726 NewByteArrayOp StablePtrRep,
728 SameMutableByteArrayOp,
732 ReadByteArrayOp CharRep,
733 ReadByteArrayOp IntRep,
734 ReadByteArrayOp WordRep,
735 ReadByteArrayOp AddrRep,
736 ReadByteArrayOp FloatRep,
737 ReadByteArrayOp DoubleRep,
738 ReadByteArrayOp StablePtrRep,
739 ReadByteArrayOp Int64Rep,
740 ReadByteArrayOp Word64Rep,
741 WriteByteArrayOp CharRep,
742 WriteByteArrayOp IntRep,
743 WriteByteArrayOp WordRep,
744 WriteByteArrayOp AddrRep,
745 WriteByteArrayOp FloatRep,
746 WriteByteArrayOp DoubleRep,
747 WriteByteArrayOp StablePtrRep,
748 WriteByteArrayOp Int64Rep,
749 WriteByteArrayOp Word64Rep,
750 IndexByteArrayOp CharRep,
751 IndexByteArrayOp IntRep,
752 IndexByteArrayOp WordRep,
753 IndexByteArrayOp AddrRep,
754 IndexByteArrayOp FloatRep,
755 IndexByteArrayOp DoubleRep,
756 IndexByteArrayOp StablePtrRep,
757 IndexByteArrayOp Int64Rep,
758 IndexByteArrayOp Word64Rep,
759 IndexOffForeignObjOp CharRep,
760 IndexOffForeignObjOp AddrRep,
761 IndexOffForeignObjOp IntRep,
762 IndexOffForeignObjOp WordRep,
763 IndexOffForeignObjOp FloatRep,
764 IndexOffForeignObjOp DoubleRep,
765 IndexOffForeignObjOp StablePtrRep,
766 IndexOffForeignObjOp Int64Rep,
767 IndexOffForeignObjOp Word64Rep,
768 IndexOffAddrOp CharRep,
769 IndexOffAddrOp IntRep,
770 IndexOffAddrOp WordRep,
771 IndexOffAddrOp AddrRep,
772 IndexOffAddrOp FloatRep,
773 IndexOffAddrOp DoubleRep,
774 IndexOffAddrOp StablePtrRep,
775 IndexOffAddrOp Int64Rep,
776 IndexOffAddrOp Word64Rep,
777 WriteOffAddrOp CharRep,
778 WriteOffAddrOp IntRep,
779 WriteOffAddrOp WordRep,
780 WriteOffAddrOp AddrRep,
781 WriteOffAddrOp FloatRep,
782 WriteOffAddrOp DoubleRep,
783 WriteOffAddrOp ForeignObjRep,
784 WriteOffAddrOp StablePtrRep,
785 WriteOffAddrOp Int64Rep,
786 WriteOffAddrOp Word64Rep,
788 UnsafeFreezeByteArrayOp,
790 UnsafeThawByteArrayOp,
792 SizeofMutableByteArrayOp,
799 BlockAsyncExceptionsOp,
800 UnblockAsyncExceptionsOp,
817 ReallyUnsafePtrEqualityOp,
840 %************************************************************************
842 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
844 %************************************************************************
846 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
847 refer to the primitive operation. The conventional \tr{#}-for-
848 unboxed ops is added on later.
850 The reason for the funny characters in the names is so we do not
851 interfere with the programmer's Haskell name spaces.
853 We use @PrimKinds@ for the ``type'' information, because they're
854 (slightly) more convenient to use than @TyCons@.
857 = Dyadic OccName -- string :: T -> T -> T
859 | Monadic OccName -- string :: T -> T
861 | Compare OccName -- string :: T -> T -> Bool
864 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
869 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
870 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
871 mkCompare str ty = Compare (mkSrcVarOcc str) ty
872 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
877 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
879 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
880 intPrimTy, byteArrayPrimTy] -- second '' pieces
881 an_Integer_and_Int_tys
882 = [intPrimTy, byteArrayPrimTy, -- Integer
885 unboxedPair = mkUnboxedTupleTy 2
886 unboxedTriple = mkUnboxedTupleTy 3
887 unboxedQuadruple = mkUnboxedTupleTy 4
889 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
890 (unboxedPair one_Integer_ty)
892 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
893 (unboxedPair one_Integer_ty)
895 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
896 (unboxedQuadruple two_Integer_tys)
898 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
901 %************************************************************************
903 \subsubsection{Strictness}
905 %************************************************************************
907 Not all primops are strict!
910 primOpStrictness :: PrimOp -> ([Demand], Bool)
911 -- See IdInfo.StrictnessInfo for discussion of what the results
912 -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,
913 -- the list of demands may be infinite!
914 -- Use only the ones you ned.
916 primOpStrictness SeqOp = ([wwStrict], False)
917 -- Seq is strict in its argument; see notes in ConFold.lhs
919 primOpStrictness ParOp = ([wwLazy], False)
920 -- But Par is lazy, to avoid that the sparked thing
921 -- gets evaluted strictly, which it should *not* be
923 primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
925 primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
926 primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
928 primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)
929 primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
931 primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
933 primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
934 primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
935 primOpStrictness BlockAsyncExceptionsOp = ([wwLazy], False)
936 primOpStrictness UnblockAsyncExceptionsOp = ([wwLazy], False)
938 primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
939 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
940 primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
942 primOpStrictness DataToTagOp = ([wwLazy], False)
944 -- The rest all have primitive-typed arguments
945 primOpStrictness other = (repeat wwPrim, False)
948 %************************************************************************
950 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
952 %************************************************************************
954 @primOpInfo@ gives all essential information (from which everything
955 else, notably a type, can be constructed) for each @PrimOp@.
958 primOpInfo :: PrimOp -> PrimOpInfo
961 There's plenty of this stuff!
964 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
965 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
966 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
967 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
968 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
969 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
971 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
972 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
973 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
974 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
975 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
976 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
978 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
979 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
980 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
981 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
982 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
983 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
985 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
986 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
987 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
988 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
989 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
990 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
992 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
993 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
994 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
995 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
996 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
997 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
999 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
1000 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
1001 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
1002 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
1003 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
1004 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
1008 %************************************************************************
1010 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
1012 %************************************************************************
1015 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
1016 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
1019 %************************************************************************
1021 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
1023 %************************************************************************
1026 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
1027 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
1028 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
1029 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
1030 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
1031 primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
1033 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
1035 primOpInfo IntAddCOp =
1036 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
1037 (unboxedPair [intPrimTy, intPrimTy])
1039 primOpInfo IntSubCOp =
1040 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
1041 (unboxedPair [intPrimTy, intPrimTy])
1043 primOpInfo IntMulCOp =
1044 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
1045 (unboxedPair [intPrimTy, intPrimTy])
1048 %************************************************************************
1050 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1052 %************************************************************************
1054 A @Word#@ is an unsigned @Int#@.
1057 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1058 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1060 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1061 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1062 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1063 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1066 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1068 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1071 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1073 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1075 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1077 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1078 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1081 %************************************************************************
1083 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1085 %************************************************************************
1088 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1089 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1093 %************************************************************************
1095 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1097 %************************************************************************
1099 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1102 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1103 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1104 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1105 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1106 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1108 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1109 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1111 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1112 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1113 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1114 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1115 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1116 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1117 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1118 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1119 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1120 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1121 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1122 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1123 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1126 %************************************************************************
1128 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1130 %************************************************************************
1132 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1135 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1136 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1137 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1138 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1139 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1141 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1142 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1144 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1145 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1147 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1148 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1149 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1150 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1151 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1152 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1153 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1154 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1155 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1156 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1157 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1158 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1159 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1162 %************************************************************************
1164 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1166 %************************************************************************
1169 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1171 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1172 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1173 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1174 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1175 primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1176 primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
1177 primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
1178 primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
1180 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1181 primOpInfo IntegerCmpIntOp
1182 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1184 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1185 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1187 primOpInfo Integer2IntOp
1188 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1190 primOpInfo Integer2WordOp
1191 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1193 primOpInfo Int2IntegerOp
1194 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1195 (unboxedPair one_Integer_ty)
1197 primOpInfo Word2IntegerOp
1198 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1199 (unboxedPair one_Integer_ty)
1201 primOpInfo Addr2IntegerOp
1202 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1203 (unboxedPair one_Integer_ty)
1205 primOpInfo IntegerToInt64Op
1206 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1208 primOpInfo Int64ToIntegerOp
1209 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1210 (unboxedPair one_Integer_ty)
1212 primOpInfo Word64ToIntegerOp
1213 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1214 (unboxedPair one_Integer_ty)
1216 primOpInfo IntegerToWord64Op
1217 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1220 Decoding of floating-point numbers is sorta Integer-related. Encoding
1221 is done with plain ccalls now (see PrelNumExtra.lhs).
1224 primOpInfo FloatDecodeOp
1225 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1226 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1227 primOpInfo DoubleDecodeOp
1228 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1229 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1232 %************************************************************************
1234 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1236 %************************************************************************
1239 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1240 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1244 primOpInfo NewArrayOp
1246 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1247 state = mkStatePrimTy s
1249 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1250 [intPrimTy, elt, state]
1251 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1253 primOpInfo (NewByteArrayOp kind)
1255 s = alphaTy; s_tv = alphaTyVar
1257 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1258 state = mkStatePrimTy s
1260 mkGenPrimOp op_str [s_tv]
1262 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1264 ---------------------------------------------------------------------------
1267 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1268 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1271 primOpInfo SameMutableArrayOp
1273 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1274 mut_arr_ty = mkMutableArrayPrimTy s elt
1276 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1279 primOpInfo SameMutableByteArrayOp
1281 s = alphaTy; s_tv = alphaTyVar;
1282 mut_arr_ty = mkMutableByteArrayPrimTy s
1284 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1287 ---------------------------------------------------------------------------
1288 -- Primitive arrays of Haskell pointers:
1291 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1292 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1293 indexArray# :: Array# a -> Int# -> (# a #)
1296 primOpInfo ReadArrayOp
1298 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1299 state = mkStatePrimTy s
1301 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1302 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1303 (unboxedPair [state, elt])
1306 primOpInfo WriteArrayOp
1308 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1310 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1311 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1314 primOpInfo IndexArrayOp
1315 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1316 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1317 (mkUnboxedTupleTy 1 [elt])
1319 ---------------------------------------------------------------------------
1320 -- Primitive arrays full of unboxed bytes:
1322 primOpInfo (ReadByteArrayOp kind)
1324 s = alphaTy; s_tv = alphaTyVar
1326 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1327 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1328 state = mkStatePrimTy s
1330 mkGenPrimOp op_str (s_tv:tvs)
1331 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1332 (unboxedPair [state, prim_ty])
1334 primOpInfo (WriteByteArrayOp kind)
1336 s = alphaTy; s_tv = alphaTyVar
1337 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1338 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1340 mkGenPrimOp op_str (s_tv:tvs)
1341 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1344 primOpInfo (IndexByteArrayOp kind)
1346 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1347 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1349 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1351 primOpInfo (IndexOffForeignObjOp kind)
1353 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1354 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1356 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1358 primOpInfo (IndexOffAddrOp kind)
1360 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1361 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1363 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1365 primOpInfo (WriteOffAddrOp kind)
1367 s = alphaTy; s_tv = alphaTyVar
1368 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1369 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1371 mkGenPrimOp op_str (s_tv:tvs)
1372 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1375 ---------------------------------------------------------------------------
1377 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1378 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1379 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1380 unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)
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 primOpInfo UnsafeThawByteArrayOp
1412 s = alphaTy; s_tv = alphaTyVar;
1413 state = mkStatePrimTy s
1415 mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]
1416 [byteArrayPrimTy, state]
1417 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1419 ---------------------------------------------------------------------------
1420 primOpInfo SizeofByteArrayOp
1422 SLIT("sizeofByteArray#") []
1426 primOpInfo SizeofMutableByteArrayOp
1427 = let { s = alphaTy; s_tv = alphaTyVar } in
1429 SLIT("sizeofMutableByteArray#") [s_tv]
1430 [mkMutableByteArrayPrimTy s]
1435 %************************************************************************
1437 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1439 %************************************************************************
1442 primOpInfo NewMutVarOp
1444 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1445 state = mkStatePrimTy s
1447 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1449 (unboxedPair [state, mkMutVarPrimTy s elt])
1451 primOpInfo ReadMutVarOp
1453 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1454 state = mkStatePrimTy s
1456 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1457 [mkMutVarPrimTy s elt, state]
1458 (unboxedPair [state, elt])
1461 primOpInfo WriteMutVarOp
1463 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1465 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1466 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1469 primOpInfo SameMutVarOp
1471 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1472 mut_var_ty = mkMutVarPrimTy s elt
1474 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1478 %************************************************************************
1480 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1482 %************************************************************************
1484 catch :: IO a -> (IOError -> IO a) -> IO a
1485 catch# :: a -> (b -> a) -> a
1487 throw :: Exception -> a
1490 blockAsyncExceptions# :: IO a -> IO a
1491 unblockAsyncExceptions# :: IO a -> IO a
1496 a = alphaTy; a_tv = alphaTyVar
1497 b = betaTy; b_tv = betaTyVar;
1499 mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
1503 a = alphaTy; a_tv = alphaTyVar
1504 b = betaTy; b_tv = betaTyVar;
1506 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1508 primOpInfo BlockAsyncExceptionsOp
1510 a = alphaTy; a_tv = alphaTyVar
1512 mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
1513 [ mkFunTy realWorldStatePrimTy (unboxedPair [realWorldStatePrimTy,a]),
1514 realWorldStatePrimTy
1516 (unboxedPair [realWorldStatePrimTy,a])
1518 primOpInfo UnblockAsyncExceptionsOp
1520 a = alphaTy; a_tv = alphaTyVar
1522 mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
1523 [ mkFunTy realWorldStatePrimTy (unboxedPair [realWorldStatePrimTy,a]),
1524 realWorldStatePrimTy
1526 (unboxedPair [realWorldStatePrimTy,a])
1529 %************************************************************************
1531 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1533 %************************************************************************
1536 primOpInfo NewMVarOp
1538 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1539 state = mkStatePrimTy s
1541 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1542 (unboxedPair [state, mkMVarPrimTy s elt])
1544 primOpInfo TakeMVarOp
1546 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1547 state = mkStatePrimTy s
1549 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1550 [mkMVarPrimTy s elt, state]
1551 (unboxedPair [state, elt])
1553 primOpInfo PutMVarOp
1555 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1557 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1558 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1561 primOpInfo SameMVarOp
1563 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1564 mvar_ty = mkMVarPrimTy s elt
1566 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1568 primOpInfo IsEmptyMVarOp
1570 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1571 state = mkStatePrimTy s
1573 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1574 [mkMVarPrimTy s elt, mkStatePrimTy s]
1575 (unboxedPair [state, intPrimTy])
1579 %************************************************************************
1581 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1583 %************************************************************************
1589 s = alphaTy; s_tv = alphaTyVar
1591 mkGenPrimOp SLIT("delay#") [s_tv]
1592 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1594 primOpInfo WaitReadOp
1596 s = alphaTy; s_tv = alphaTyVar
1598 mkGenPrimOp SLIT("waitRead#") [s_tv]
1599 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1601 primOpInfo WaitWriteOp
1603 s = alphaTy; s_tv = alphaTyVar
1605 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1606 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1609 %************************************************************************
1611 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1613 %************************************************************************
1616 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1618 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1619 [alphaTy, realWorldStatePrimTy]
1620 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1622 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1623 primOpInfo KillThreadOp
1624 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1625 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1626 realWorldStatePrimTy
1628 -- yield# :: State# RealWorld -> State# RealWorld
1630 = mkGenPrimOp SLIT("yield#") []
1631 [realWorldStatePrimTy]
1632 realWorldStatePrimTy
1634 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1635 primOpInfo MyThreadIdOp
1636 = mkGenPrimOp SLIT("myThreadId#") []
1637 [realWorldStatePrimTy]
1638 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1641 ************************************************************************
1643 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1645 %************************************************************************
1648 primOpInfo MakeForeignObjOp
1649 = mkGenPrimOp SLIT("makeForeignObj#") []
1650 [addrPrimTy, realWorldStatePrimTy]
1651 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1653 primOpInfo WriteForeignObjOp
1655 s = alphaTy; s_tv = alphaTyVar
1657 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1658 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1661 ************************************************************************
1663 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1665 %************************************************************************
1667 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1669 mkWeak# :: k -> v -> f -> State# RealWorld
1670 -> (# State# RealWorld, Weak# v #)
1672 In practice, you'll use the higher-level
1674 data Weak v = Weak# v
1675 mkWeak :: k -> v -> IO () -> IO (Weak v)
1679 = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
1680 [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
1681 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1684 The following operation dereferences a weak pointer. The weak pointer
1685 may have been finalized, so the operation returns a result code which
1686 must be inspected before looking at the dereferenced value.
1688 deRefWeak# :: Weak# v -> State# RealWorld ->
1689 (# State# RealWorld, v, Int# #)
1691 Only look at v if the Int# returned is /= 0 !!
1693 The higher-level op is
1695 deRefWeak :: Weak v -> IO (Maybe v)
1698 primOpInfo DeRefWeakOp
1699 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1700 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1701 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1704 Weak pointers can be finalized early by using the finalize# operation:
1706 finalizeWeak# :: Weak# v -> State# RealWorld ->
1707 (# State# RealWorld, Int#, IO () #)
1709 The Int# returned is either
1711 0 if the weak pointer has already been finalized, or it has no
1712 finalizer (the third component is then invalid).
1714 1 if the weak pointer is still alive, with the finalizer returned
1715 as the third component.
1718 primOpInfo FinalizeWeakOp
1719 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1720 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1721 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1722 mkFunTy realWorldStatePrimTy
1723 (unboxedPair [realWorldStatePrimTy,unitTy])])
1726 %************************************************************************
1728 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1730 %************************************************************************
1732 A {\em stable name/pointer} is an index into a table of stable name
1733 entries. Since the garbage collector is told about stable pointers,
1734 it is safe to pass a stable pointer to external systems such as C
1738 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1739 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1740 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1741 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1744 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1745 operation since it doesn't (directly) involve IO operations. The
1746 reason is that if some optimisation pass decided to duplicate calls to
1747 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1748 massive space leak can result. Putting it into the IO monad
1749 prevents this. (Another reason for putting them in a monad is to
1750 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1753 An important property of stable pointers is that if you call
1754 makeStablePtr# twice on the same object you get the same stable
1757 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1758 besides, it's not likely to be used from Haskell) so it's not a
1761 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1766 A stable name is like a stable pointer, but with three important differences:
1768 (a) You can't deRef one to get back to the original object.
1769 (b) You can convert one to an Int.
1770 (c) You don't need to 'freeStableName'
1772 The existence of a stable name doesn't guarantee to keep the object it
1773 points to alive (unlike a stable pointer), hence (a).
1777 (a) makeStableName always returns the same value for a given
1778 object (same as stable pointers).
1780 (b) if two stable names are equal, it implies that the objects
1781 from which they were created were the same.
1783 (c) stableNameToInt always returns the same Int for a given
1787 primOpInfo MakeStablePtrOp
1788 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1789 [alphaTy, realWorldStatePrimTy]
1790 (unboxedPair [realWorldStatePrimTy,
1791 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1793 primOpInfo DeRefStablePtrOp
1794 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1795 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1796 (unboxedPair [realWorldStatePrimTy, alphaTy])
1798 primOpInfo EqStablePtrOp
1799 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1800 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1803 primOpInfo MakeStableNameOp
1804 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1805 [alphaTy, realWorldStatePrimTy]
1806 (unboxedPair [realWorldStatePrimTy,
1807 mkTyConApp stableNamePrimTyCon [alphaTy]])
1809 primOpInfo EqStableNameOp
1810 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1811 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1814 primOpInfo StableNameToIntOp
1815 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1816 [mkStableNamePrimTy alphaTy]
1820 %************************************************************************
1822 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1824 %************************************************************************
1826 [Alastair Reid is to blame for this!]
1828 These days, (Glasgow) Haskell seems to have a bit of everything from
1829 other languages: strict operations, mutable variables, sequencing,
1830 pointers, etc. About the only thing left is LISP's ability to test
1831 for pointer equality. So, let's add it in!
1834 reallyUnsafePtrEquality :: a -> a -> Int#
1837 which tests any two closures (of the same type) to see if they're the
1838 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1839 difficulties of trying to box up the result.)
1841 NB This is {\em really unsafe\/} because even something as trivial as
1842 a garbage collection might change the answer by removing indirections.
1843 Still, no-one's forcing you to use it. If you're worried about little
1844 things like loss of referential transparency, you might like to wrap
1845 it all up in a monad-like thing as John O'Donnell and John Hughes did
1846 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1849 I'm thinking of using it to speed up a critical equality test in some
1850 graphics stuff in a context where the possibility of saying that
1851 denotationally equal things aren't isn't a problem (as long as it
1852 doesn't happen too often.) ADR
1854 To Will: Jim said this was already in, but I can't see it so I'm
1855 adding it. Up to you whether you add it. (Note that this could have
1856 been readily implemented using a @veryDangerousCCall@ before they were
1860 primOpInfo ReallyUnsafePtrEqualityOp
1861 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1862 [alphaTy, alphaTy] intPrimTy
1865 %************************************************************************
1867 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1869 %************************************************************************
1872 primOpInfo SeqOp -- seq# :: a -> Int#
1873 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1875 primOpInfo ParOp -- par# :: a -> Int#
1876 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1880 -- HWL: The first 4 Int# in all par... annotations denote:
1881 -- name, granularity info, size of result, degree of parallelism
1882 -- Same structure as _seq_ i.e. returns Int#
1883 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1884 -- `the processor containing the expression v'; it is not evaluated
1886 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1887 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1889 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1890 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1892 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1893 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1895 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1896 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1898 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1899 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1901 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1902 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1904 primOpInfo CopyableOp -- copyable# :: a -> Int#
1905 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1907 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1908 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1911 %************************************************************************
1913 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1915 %************************************************************************
1918 primOpInfo (CCallOp _ _ _ _)
1919 = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
1922 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1923 = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
1925 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1929 %************************************************************************
1931 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1933 %************************************************************************
1935 These primops are pretty wierd.
1937 dataToTag# :: a -> Int (arg must be an evaluated data type)
1938 tagToEnum# :: Int -> a (result type must be an enumerated type)
1940 The constraints aren't currently checked by the front end, but the
1941 code generator will fall over if they aren't satisfied.
1944 primOpInfo DataToTagOp
1945 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1947 primOpInfo TagToEnumOp
1948 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1951 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1955 %************************************************************************
1957 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1959 %************************************************************************
1961 Some PrimOps need to be called out-of-line because they either need to
1962 perform a heap check or they block.
1974 BlockAsyncExceptionsOp -> True
1975 UnblockAsyncExceptionsOp -> True
1977 NewByteArrayOp _ -> True
1978 IntegerAddOp -> True
1979 IntegerSubOp -> True
1980 IntegerMulOp -> True
1981 IntegerGcdOp -> True
1982 IntegerDivExactOp -> True
1983 IntegerQuotOp -> True
1984 IntegerRemOp -> True
1985 IntegerQuotRemOp -> True
1986 IntegerDivModOp -> True
1987 Int2IntegerOp -> True
1988 Word2IntegerOp -> True
1989 Addr2IntegerOp -> True
1990 Word64ToIntegerOp -> True
1991 Int64ToIntegerOp -> True
1992 FloatDecodeOp -> True
1993 DoubleDecodeOp -> True
1995 FinalizeWeakOp -> True
1996 MakeStableNameOp -> True
1997 MakeForeignObjOp -> True
2001 KillThreadOp -> True
2003 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
2004 -- the next one doesn't perform any heap checks,
2005 -- but it is of such an esoteric nature that
2006 -- it is done out-of-line rather than require
2007 -- the NCG to implement it.
2008 UnsafeThawArrayOp -> True
2013 primOpOkForSpeculation
2014 ~~~~~~~~~~~~~~~~~~~~~~
2015 Sometimes we may choose to execute a PrimOp even though it isn't
2016 certain that its result will be required; ie execute them
2017 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
2018 this is OK, because PrimOps are usually cheap, but it isn't OK for
2019 (a)~expensive PrimOps and (b)~PrimOps which can fail.
2021 PrimOps that have side effects also should not be executed speculatively.
2023 Ok-for-speculation also means that it's ok *not* to execute the
2027 Here the result is not used, so we can discard the primop. Anything
2028 that has side effects mustn't be dicarded in this way, of course!
2030 See also @primOpIsCheap@ (below).
2034 primOpOkForSpeculation :: PrimOp -> Bool
2035 -- See comments with CoreUtils.exprOkForSpeculation
2036 primOpOkForSpeculation op
2037 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
2043 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
2044 WARNING), we just borrow some other predicates for a
2045 what-should-be-good-enough test. "Cheap" means willing to call it more
2046 than once. Evaluation order is unaffected.
2049 primOpIsCheap :: PrimOp -> Bool
2050 -- See comments with CoreUtils.exprOkForSpeculation
2051 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
2056 primOpIsDupable means that the use of the primop is small enough to
2057 duplicate into different case branches. See CoreUtils.exprIsDupable.
2060 primOpIsDupable :: PrimOp -> Bool
2061 -- See comments with CoreUtils.exprIsDupable
2062 primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc
2063 -- If the ccall can't GC then the call is pretty cheap, and
2064 -- we're happy to duplicate
2065 primOpIsDupable op = not (primOpOutOfLine op)
2070 primOpCanFail :: PrimOp -> Bool
2072 primOpCanFail IntQuotOp = True -- Divide by zero
2073 primOpCanFail IntRemOp = True -- Divide by zero
2076 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2077 primOpCanFail IntegerDivModOp = True -- Divide by zero
2079 -- Float. ToDo: tan? tanh?
2080 primOpCanFail FloatDivOp = True -- Divide by zero
2081 primOpCanFail FloatLogOp = True -- Log of zero
2082 primOpCanFail FloatAsinOp = True -- Arg out of domain
2083 primOpCanFail FloatAcosOp = True -- Arg out of domain
2085 -- Double. ToDo: tan? tanh?
2086 primOpCanFail DoubleDivOp = True -- Divide by zero
2087 primOpCanFail DoubleLogOp = True -- Log of zero
2088 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2089 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2091 primOpCanFail other_op = False
2094 And some primops have side-effects and so, for example, must not be
2098 primOpHasSideEffects :: PrimOp -> Bool
2100 primOpHasSideEffects ParOp = True
2101 primOpHasSideEffects ForkOp = True
2102 primOpHasSideEffects KillThreadOp = True
2103 primOpHasSideEffects YieldOp = True
2104 primOpHasSideEffects SeqOp = True
2106 primOpHasSideEffects MakeForeignObjOp = True
2107 primOpHasSideEffects WriteForeignObjOp = True
2108 primOpHasSideEffects MkWeakOp = True
2109 primOpHasSideEffects DeRefWeakOp = True
2110 primOpHasSideEffects FinalizeWeakOp = True
2111 primOpHasSideEffects MakeStablePtrOp = True
2112 primOpHasSideEffects MakeStableNameOp = True
2113 primOpHasSideEffects EqStablePtrOp = True -- SOF
2114 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2116 -- In general, writes are considered a side effect, but
2117 -- reads and variable allocations are not
2118 -- Why? Because writes must not be omitted, but reads can be if their result is not used.
2119 -- (Sequencing of reads is maintained by data dependencies on the resulting
2121 primOpHasSideEffects WriteArrayOp = True
2122 primOpHasSideEffects (WriteByteArrayOp _) = True
2123 primOpHasSideEffects (WriteOffAddrOp _) = True
2124 primOpHasSideEffects WriteMutVarOp = True
2126 primOpHasSideEffects UnsafeFreezeArrayOp = True
2127 primOpHasSideEffects UnsafeFreezeByteArrayOp = True
2128 primOpHasSideEffects UnsafeThawArrayOp = True
2129 primOpHasSideEffects UnsafeThawByteArrayOp = True
2131 primOpHasSideEffects TakeMVarOp = True
2132 primOpHasSideEffects PutMVarOp = True
2133 primOpHasSideEffects DelayOp = True
2134 primOpHasSideEffects WaitReadOp = True
2135 primOpHasSideEffects WaitWriteOp = True
2137 primOpHasSideEffects ParGlobalOp = True
2138 primOpHasSideEffects ParLocalOp = True
2139 primOpHasSideEffects ParAtOp = True
2140 primOpHasSideEffects ParAtAbsOp = True
2141 primOpHasSideEffects ParAtRelOp = True
2142 primOpHasSideEffects ParAtForNowOp = True
2143 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2144 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2147 primOpHasSideEffects (CCallOp _ _ _ _) = True
2149 primOpHasSideEffects other = False
2152 Inline primitive operations that perform calls need wrappers to save
2153 any live variables that are stored in caller-saves registers.
2156 primOpNeedsWrapper :: PrimOp -> Bool
2158 primOpNeedsWrapper (CCallOp _ _ _ _) = True
2160 primOpNeedsWrapper Integer2IntOp = True
2161 primOpNeedsWrapper Integer2WordOp = True
2162 primOpNeedsWrapper IntegerCmpOp = True
2163 primOpNeedsWrapper IntegerCmpIntOp = True
2165 primOpNeedsWrapper FloatExpOp = True
2166 primOpNeedsWrapper FloatLogOp = True
2167 primOpNeedsWrapper FloatSqrtOp = True
2168 primOpNeedsWrapper FloatSinOp = True
2169 primOpNeedsWrapper FloatCosOp = True
2170 primOpNeedsWrapper FloatTanOp = True
2171 primOpNeedsWrapper FloatAsinOp = True
2172 primOpNeedsWrapper FloatAcosOp = True
2173 primOpNeedsWrapper FloatAtanOp = True
2174 primOpNeedsWrapper FloatSinhOp = True
2175 primOpNeedsWrapper FloatCoshOp = True
2176 primOpNeedsWrapper FloatTanhOp = True
2177 primOpNeedsWrapper FloatPowerOp = True
2179 primOpNeedsWrapper DoubleExpOp = True
2180 primOpNeedsWrapper DoubleLogOp = True
2181 primOpNeedsWrapper DoubleSqrtOp = True
2182 primOpNeedsWrapper DoubleSinOp = True
2183 primOpNeedsWrapper DoubleCosOp = True
2184 primOpNeedsWrapper DoubleTanOp = True
2185 primOpNeedsWrapper DoubleAsinOp = True
2186 primOpNeedsWrapper DoubleAcosOp = True
2187 primOpNeedsWrapper DoubleAtanOp = True
2188 primOpNeedsWrapper DoubleSinhOp = True
2189 primOpNeedsWrapper DoubleCoshOp = True
2190 primOpNeedsWrapper DoubleTanhOp = True
2191 primOpNeedsWrapper DoublePowerOp = True
2193 primOpNeedsWrapper MakeStableNameOp = True
2194 primOpNeedsWrapper DeRefStablePtrOp = True
2196 primOpNeedsWrapper DelayOp = True
2197 primOpNeedsWrapper WaitReadOp = True
2198 primOpNeedsWrapper WaitWriteOp = True
2200 primOpNeedsWrapper other_op = False
2204 primOpArity :: PrimOp -> Arity
2206 = case (primOpInfo op) of
2210 GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
2212 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2214 = case (primOpInfo op) of
2215 Dyadic occ ty -> dyadic_fun_ty ty
2216 Monadic occ ty -> monadic_fun_ty ty
2217 Compare occ ty -> compare_fun_ty ty
2219 GenPrimOp occ tyvars arg_tys res_ty ->
2220 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2222 mkPrimOpIdName :: PrimOp -> Id -> Name
2223 -- Make the name for the PrimOp's Id
2224 -- We have to pass in the Id itself because it's a WiredInId
2225 -- and hence recursive
2226 mkPrimOpIdName op id
2227 = mkWiredInIdName key pREL_GHC occ_name id
2229 occ_name = primOpOcc op
2230 key = mkPrimOpIdUnique (primOpTag op)
2233 primOpRdrName :: PrimOp -> RdrName
2234 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2236 primOpOcc :: PrimOp -> OccName
2237 primOpOcc op = case (primOpInfo op) of
2239 Monadic occ _ -> occ
2240 Compare occ _ -> occ
2241 GenPrimOp occ _ _ _ -> occ
2243 -- primOpSig is like primOpType but gives the result split apart:
2244 -- (type variables, argument types, result type)
2246 primOpSig :: PrimOp -> ([TyVar],[Type],Type)
2248 = case (primOpInfo op) of
2249 Monadic occ ty -> ([], [ty], ty )
2250 Dyadic occ ty -> ([], [ty,ty], ty )
2251 Compare occ ty -> ([], [ty,ty], boolTy)
2252 GenPrimOp occ tyvars arg_tys res_ty
2253 -> (tyvars, arg_tys, res_ty)
2255 -- primOpUsg is like primOpSig but the types it yields are the
2256 -- appropriate sigma (i.e., usage-annotated) types,
2257 -- as required by the UsageSP inference.
2259 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2263 -- Refer to comment by `otherwise' clause; we need consider here
2264 -- *only* primops that have arguments or results containing Haskell
2265 -- pointers (things that are pointed). Unpointed values are
2266 -- irrelevant to the usage analysis. The issue is whether pointed
2267 -- values may be entered or duplicated by the primop.
2269 -- Remember that primops are *never* partially applied.
2271 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2272 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2273 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2274 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2275 IndexArrayOp -> mangle [mkM, mkP ] mkM
2276 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2277 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2279 NewMutVarOp -> mangle [mkM, mkP ] mkM
2280 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2281 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2282 SameMutVarOp -> mangle [mkP, mkP ] mkM
2284 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2285 mangle [mkM, mkM . (inFun mkM mkM)] mkM
2286 -- might use caught action multiply
2287 RaiseOp -> mangle [mkM ] mkM
2289 NewMVarOp -> mangle [mkP ] mkR
2290 TakeMVarOp -> mangle [mkM, mkP ] mkM
2291 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2292 SameMVarOp -> mangle [mkP, mkP ] mkM
2293 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2295 ForkOp -> mangle [mkO, mkP ] mkR
2296 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2298 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2299 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2300 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2302 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2303 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2304 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2305 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2306 EqStableNameOp -> mangle [mkP, mkP ] mkR
2307 StableNameToIntOp -> mangle [mkP ] mkR
2309 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2311 SeqOp -> mangle [mkO ] mkR
2312 ParOp -> mangle [mkO ] mkR
2313 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2314 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2315 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2316 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2317 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2318 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2319 CopyableOp -> mangle [mkZ ] mkR
2320 NoFollowOp -> mangle [mkZ ] mkR
2322 CCallOp _ _ _ _ -> mangle [ ] mkM
2324 -- Things with no Haskell pointers inside: in actuality, usages are
2325 -- irrelevant here (hence it doesn't matter that some of these
2326 -- apparently permit duplication; since such arguments are never
2327 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2328 -- except insofar as it propagates to infect other values that *are*
2331 otherwise -> nomangle
2333 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2334 mkO = mkUsgTy UsOnce -- pointed argument used once
2335 mkM = mkUsgTy UsMany -- pointed argument used multiply
2336 mkP = mkUsgTy UsOnce -- unpointed argument
2337 mkR = mkUsgTy UsMany -- unpointed result
2339 (tyvars, arg_tys, res_ty)
2342 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2344 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2346 inFun f g ty = case splitFunTy_maybe ty of
2347 Just (a,b) -> mkFunTy (f a) (g b)
2348 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2350 inUB fs ty = case splitTyConApp_maybe ty of
2351 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
2352 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
2354 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2358 data PrimOpResultInfo
2359 = ReturnsPrim PrimRep
2362 -- Some PrimOps need not return a manifest primitive or algebraic value
2363 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2364 -- be out of line, or the code generator won't work.
2366 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2367 getPrimOpResultInfo op
2368 = case (primOpInfo op) of
2369 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2370 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2371 Compare _ ty -> ReturnsAlg boolTyCon
2372 GenPrimOp _ _ _ ty ->
2373 let rep = typePrimRep ty in
2375 PtrRep -> case splitAlgTyConApp_maybe ty of
2376 Nothing -> panic "getPrimOpResultInfo"
2377 Just (tc,_,_) -> ReturnsAlg tc
2378 other -> ReturnsPrim other
2380 isCompareOp :: PrimOp -> Bool
2382 = case primOpInfo op of
2387 The commutable ops are those for which we will try to move constants
2388 to the right hand side for strength reduction.
2391 commutableOp :: PrimOp -> Bool
2393 commutableOp CharEqOp = True
2394 commutableOp CharNeOp = True
2395 commutableOp IntAddOp = True
2396 commutableOp IntMulOp = True
2397 commutableOp AndOp = True
2398 commutableOp OrOp = True
2399 commutableOp XorOp = True
2400 commutableOp IntEqOp = True
2401 commutableOp IntNeOp = True
2402 commutableOp IntegerAddOp = True
2403 commutableOp IntegerMulOp = True
2404 commutableOp IntegerGcdOp = True
2405 commutableOp IntegerIntGcdOp = True
2406 commutableOp FloatAddOp = True
2407 commutableOp FloatMulOp = True
2408 commutableOp FloatEqOp = True
2409 commutableOp FloatNeOp = True
2410 commutableOp DoubleAddOp = True
2411 commutableOp DoubleMulOp = True
2412 commutableOp DoubleEqOp = True
2413 commutableOp DoubleNeOp = True
2414 commutableOp _ = False
2419 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2420 -- CharRep --> ([], Char#)
2421 -- StablePtrRep --> ([a], StablePtr# a)
2422 mkPrimTyApp tvs kind
2423 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2425 tycon = primRepTyCon kind
2426 forall_tvs = take (tyConArity tycon) tvs
2428 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2429 monadic_fun_ty ty = mkFunTy ty ty
2430 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2435 pprPrimOp :: PrimOp -> SDoc
2437 pprPrimOp (CCallOp fun is_casm may_gc cconv)
2439 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2442 | is_casm && may_gc = "casm_GC ``"
2443 | is_casm = "casm ``"
2444 | may_gc = "ccall_GC "
2445 | otherwise = "ccall "
2448 | is_casm = text "''"
2453 Right _ -> text "dyn_"
2458 Right _ -> text "\"\""
2462 hcat [ ifPprDebug callconv
2463 , text "__", ppr_dyn
2464 , text before , ppr_fun , after]
2467 = getPprStyle $ \ sty ->
2468 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2469 ptext SLIT("PrelGHC.") <> pprOccName occ
2473 occ = primOpOcc other_op