2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[PrimOp]{Primitive operations (machine-level)}
8 PrimOp(..), allThePrimOps,
9 primOpType, primOpSig, primOpUsg,
10 mkPrimOpIdName, primOpRdrName,
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,
39 splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
42 import Unique ( Unique, mkPrimOpIdUnique )
43 import PrelMods ( pREL_GHC, pREL_GHC_Name )
45 import Util ( assoc, zipWithEqual )
46 import GlaExts ( Int(..), Int#, (==#) )
49 %************************************************************************
51 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
53 %************************************************************************
55 These are in \tr{state-interface.verb} order.
59 -- dig the FORTRAN/C influence on the names...
63 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
64 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
65 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
66 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
67 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
68 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
74 -- IntAbsOp unused?? ADR
75 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
76 | IntRemOp | IntNegOp | IntAbsOp
77 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
83 | WordQuotOp | WordRemOp
84 | AndOp | OrOp | NotOp | XorOp
85 | SllOp | SrlOp -- shift {left,right} {logical}
86 | Int2WordOp | Word2IntOp -- casts
89 | Int2AddrOp | Addr2IntOp -- casts
91 -- Float#-related ops:
92 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
93 | Float2IntOp | Int2FloatOp
95 | FloatExpOp | FloatLogOp | FloatSqrtOp
96 | FloatSinOp | FloatCosOp | FloatTanOp
97 | FloatAsinOp | FloatAcosOp | FloatAtanOp
98 | FloatSinhOp | FloatCoshOp | FloatTanhOp
99 -- not all machines have these available conveniently:
100 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
101 | FloatPowerOp -- ** op
103 -- Double#-related ops:
104 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
105 | Double2IntOp | Int2DoubleOp
106 | Double2FloatOp | Float2DoubleOp
108 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
109 | DoubleSinOp | DoubleCosOp | DoubleTanOp
110 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
111 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
112 -- not all machines have these available conveniently:
113 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
114 | DoublePowerOp -- ** op
116 -- Integer (and related...) ops:
117 -- slightly weird -- to match GMP package.
118 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
119 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
124 | Integer2IntOp | Integer2WordOp
125 | Int2IntegerOp | Word2IntegerOp
127 -- casting to/from Integer and 64-bit (un)signed quantities.
128 | IntegerToInt64Op | Int64ToIntegerOp
129 | IntegerToWord64Op | Word64ToIntegerOp
135 -- primitive ops for primitive arrays
138 | NewByteArrayOp PrimRep
141 | SameMutableByteArrayOp
143 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
145 | ReadByteArrayOp PrimRep
146 | WriteByteArrayOp PrimRep
147 | IndexByteArrayOp PrimRep
148 | IndexOffAddrOp PrimRep
149 | WriteOffAddrOp PrimRep
150 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
151 -- This is just a cheesy encoding of a bunch of ops.
152 -- Note that ForeignObjRep is not included -- the only way of
153 -- creating a ForeignObj is with a ccall or casm.
154 | IndexOffForeignObjOp PrimRep
156 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
157 | UnsafeThawArrayOp | UnsafeThawByteArrayOp
158 | SizeofByteArrayOp | SizeofMutableByteArrayOp
197 A special ``trap-door'' to use in making calls direct to C functions:
200 FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
201 Unique) -- Right u => first argument (an Addr#) is the function pointer
202 -- (unique is used to generate a 'typedef' to cast
203 -- the function pointer if compiling the ccall# down to
204 -- .hc code - can't do this inline for tedious reasons.)
206 Bool -- True <=> really a "casm"
207 Bool -- True <=> might invoke Haskell GC
208 CallConv -- calling convention to use.
210 -- (... to be continued ... )
213 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
214 (See @primOpInfo@ for details.)
216 Note: that first arg and part of the result should be the system state
217 token (which we carry around to fool over-zealous optimisers) but
218 which isn't actually passed.
220 For example, we represent
222 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
228 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
229 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
233 (AlgAlts [ ( FloatPrimAndIoWorld,
235 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
241 Nota Bene: there are some people who find the empty list of types in
242 the @Prim@ somewhat puzzling and would represent the above by
246 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
247 -- :: /\ alpha1, alpha2 alpha3, alpha4.
248 -- alpha1 -> alpha2 -> alpha3 -> alpha4
249 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
252 (AlgAlts [ ( FloatPrimAndIoWorld,
254 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
260 But, this is a completely different way of using @CCallOp@. The most
261 major changes required if we switch to this are in @primOpInfo@, and
262 the desugarer. The major difficulty is in moving the HeapRequirement
263 stuff somewhere appropriate. (The advantage is that we could simplify
264 @CCallOp@ and record just the number of arguments with corresponding
265 simplifications in reading pragma unfoldings, the simplifier,
266 instantiation (etc) of core expressions, ... . Maybe we should think
267 about using it this way?? ADR)
270 -- (... continued from above ... )
272 -- Operation to test two closure addresses for equality (yes really!)
273 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
274 | ReallyUnsafePtrEqualityOp
289 -- more parallel stuff
290 | ParGlobalOp -- named global par
291 | ParLocalOp -- named local par
292 | ParAtOp -- specifies destination of local par
293 | ParAtAbsOp -- specifies destination of local par (abs processor)
294 | ParAtRelOp -- specifies destination of local par (rel processor)
295 | ParAtForNowOp -- specifies initial destination of global par
296 | CopyableOp -- marks copyable code
297 | NoFollowOp -- marks non-followup expression
304 Used for the Ord instance
307 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
308 tagOf_PrimOp CharGeOp = ILIT( 2)
309 tagOf_PrimOp CharEqOp = ILIT( 3)
310 tagOf_PrimOp CharNeOp = ILIT( 4)
311 tagOf_PrimOp CharLtOp = ILIT( 5)
312 tagOf_PrimOp CharLeOp = ILIT( 6)
313 tagOf_PrimOp IntGtOp = ILIT( 7)
314 tagOf_PrimOp IntGeOp = ILIT( 8)
315 tagOf_PrimOp IntEqOp = ILIT( 9)
316 tagOf_PrimOp IntNeOp = ILIT( 10)
317 tagOf_PrimOp IntLtOp = ILIT( 11)
318 tagOf_PrimOp IntLeOp = ILIT( 12)
319 tagOf_PrimOp WordGtOp = ILIT( 13)
320 tagOf_PrimOp WordGeOp = ILIT( 14)
321 tagOf_PrimOp WordEqOp = ILIT( 15)
322 tagOf_PrimOp WordNeOp = ILIT( 16)
323 tagOf_PrimOp WordLtOp = ILIT( 17)
324 tagOf_PrimOp WordLeOp = ILIT( 18)
325 tagOf_PrimOp AddrGtOp = ILIT( 19)
326 tagOf_PrimOp AddrGeOp = ILIT( 20)
327 tagOf_PrimOp AddrEqOp = ILIT( 21)
328 tagOf_PrimOp AddrNeOp = ILIT( 22)
329 tagOf_PrimOp AddrLtOp = ILIT( 23)
330 tagOf_PrimOp AddrLeOp = ILIT( 24)
331 tagOf_PrimOp FloatGtOp = ILIT( 25)
332 tagOf_PrimOp FloatGeOp = ILIT( 26)
333 tagOf_PrimOp FloatEqOp = ILIT( 27)
334 tagOf_PrimOp FloatNeOp = ILIT( 28)
335 tagOf_PrimOp FloatLtOp = ILIT( 29)
336 tagOf_PrimOp FloatLeOp = ILIT( 30)
337 tagOf_PrimOp DoubleGtOp = ILIT( 31)
338 tagOf_PrimOp DoubleGeOp = ILIT( 32)
339 tagOf_PrimOp DoubleEqOp = ILIT( 33)
340 tagOf_PrimOp DoubleNeOp = ILIT( 34)
341 tagOf_PrimOp DoubleLtOp = ILIT( 35)
342 tagOf_PrimOp DoubleLeOp = ILIT( 36)
343 tagOf_PrimOp OrdOp = ILIT( 37)
344 tagOf_PrimOp ChrOp = ILIT( 38)
345 tagOf_PrimOp IntAddOp = ILIT( 39)
346 tagOf_PrimOp IntSubOp = ILIT( 40)
347 tagOf_PrimOp IntMulOp = ILIT( 41)
348 tagOf_PrimOp IntQuotOp = ILIT( 42)
349 tagOf_PrimOp IntRemOp = ILIT( 43)
350 tagOf_PrimOp IntNegOp = ILIT( 44)
351 tagOf_PrimOp IntAbsOp = ILIT( 45)
352 tagOf_PrimOp WordQuotOp = ILIT( 46)
353 tagOf_PrimOp WordRemOp = ILIT( 47)
354 tagOf_PrimOp AndOp = ILIT( 48)
355 tagOf_PrimOp OrOp = ILIT( 49)
356 tagOf_PrimOp NotOp = ILIT( 50)
357 tagOf_PrimOp XorOp = ILIT( 51)
358 tagOf_PrimOp SllOp = ILIT( 52)
359 tagOf_PrimOp SrlOp = ILIT( 53)
360 tagOf_PrimOp ISllOp = ILIT( 54)
361 tagOf_PrimOp ISraOp = ILIT( 55)
362 tagOf_PrimOp ISrlOp = ILIT( 56)
363 tagOf_PrimOp IntAddCOp = ILIT( 57)
364 tagOf_PrimOp IntSubCOp = ILIT( 58)
365 tagOf_PrimOp IntMulCOp = ILIT( 59)
366 tagOf_PrimOp Int2WordOp = ILIT( 60)
367 tagOf_PrimOp Word2IntOp = ILIT( 61)
368 tagOf_PrimOp Int2AddrOp = ILIT( 62)
369 tagOf_PrimOp Addr2IntOp = ILIT( 63)
371 tagOf_PrimOp FloatAddOp = ILIT( 64)
372 tagOf_PrimOp FloatSubOp = ILIT( 65)
373 tagOf_PrimOp FloatMulOp = ILIT( 66)
374 tagOf_PrimOp FloatDivOp = ILIT( 67)
375 tagOf_PrimOp FloatNegOp = ILIT( 68)
376 tagOf_PrimOp Float2IntOp = ILIT( 69)
377 tagOf_PrimOp Int2FloatOp = ILIT( 70)
378 tagOf_PrimOp FloatExpOp = ILIT( 71)
379 tagOf_PrimOp FloatLogOp = ILIT( 72)
380 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
381 tagOf_PrimOp FloatSinOp = ILIT( 74)
382 tagOf_PrimOp FloatCosOp = ILIT( 75)
383 tagOf_PrimOp FloatTanOp = ILIT( 76)
384 tagOf_PrimOp FloatAsinOp = ILIT( 77)
385 tagOf_PrimOp FloatAcosOp = ILIT( 78)
386 tagOf_PrimOp FloatAtanOp = ILIT( 79)
387 tagOf_PrimOp FloatSinhOp = ILIT( 80)
388 tagOf_PrimOp FloatCoshOp = ILIT( 81)
389 tagOf_PrimOp FloatTanhOp = ILIT( 82)
390 tagOf_PrimOp FloatPowerOp = ILIT( 83)
392 tagOf_PrimOp DoubleAddOp = ILIT( 84)
393 tagOf_PrimOp DoubleSubOp = ILIT( 85)
394 tagOf_PrimOp DoubleMulOp = ILIT( 86)
395 tagOf_PrimOp DoubleDivOp = ILIT( 87)
396 tagOf_PrimOp DoubleNegOp = ILIT( 88)
397 tagOf_PrimOp Double2IntOp = ILIT( 89)
398 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
399 tagOf_PrimOp Double2FloatOp = ILIT( 91)
400 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
401 tagOf_PrimOp DoubleExpOp = ILIT( 93)
402 tagOf_PrimOp DoubleLogOp = ILIT( 94)
403 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
404 tagOf_PrimOp DoubleSinOp = ILIT( 96)
405 tagOf_PrimOp DoubleCosOp = ILIT( 97)
406 tagOf_PrimOp DoubleTanOp = ILIT( 98)
407 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
408 tagOf_PrimOp DoubleAcosOp = ILIT(100)
409 tagOf_PrimOp DoubleAtanOp = ILIT(101)
410 tagOf_PrimOp DoubleSinhOp = ILIT(102)
411 tagOf_PrimOp DoubleCoshOp = ILIT(103)
412 tagOf_PrimOp DoubleTanhOp = ILIT(104)
413 tagOf_PrimOp DoublePowerOp = ILIT(105)
415 tagOf_PrimOp IntegerAddOp = ILIT(106)
416 tagOf_PrimOp IntegerSubOp = ILIT(107)
417 tagOf_PrimOp IntegerMulOp = ILIT(108)
418 tagOf_PrimOp IntegerGcdOp = ILIT(109)
419 tagOf_PrimOp IntegerQuotRemOp = ILIT(110)
420 tagOf_PrimOp IntegerDivModOp = ILIT(111)
421 tagOf_PrimOp IntegerNegOp = ILIT(112)
422 tagOf_PrimOp IntegerCmpOp = ILIT(113)
423 tagOf_PrimOp IntegerCmpIntOp = ILIT(114)
424 tagOf_PrimOp Integer2IntOp = ILIT(115)
425 tagOf_PrimOp Integer2WordOp = ILIT(116)
426 tagOf_PrimOp Int2IntegerOp = ILIT(117)
427 tagOf_PrimOp Word2IntegerOp = ILIT(118)
428 tagOf_PrimOp Addr2IntegerOp = ILIT(119)
429 tagOf_PrimOp IntegerToInt64Op = ILIT(120)
430 tagOf_PrimOp Int64ToIntegerOp = ILIT(121)
431 tagOf_PrimOp IntegerToWord64Op = ILIT(122)
432 tagOf_PrimOp Word64ToIntegerOp = ILIT(123)
433 tagOf_PrimOp FloatDecodeOp = ILIT(125)
434 tagOf_PrimOp DoubleDecodeOp = ILIT(127)
436 tagOf_PrimOp NewArrayOp = ILIT(128)
437 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129)
438 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130)
439 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131)
440 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132)
441 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133)
442 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134)
443 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135)
445 tagOf_PrimOp SameMutableArrayOp = ILIT(136)
446 tagOf_PrimOp SameMutableByteArrayOp = ILIT(137)
447 tagOf_PrimOp ReadArrayOp = ILIT(138)
448 tagOf_PrimOp WriteArrayOp = ILIT(139)
449 tagOf_PrimOp IndexArrayOp = ILIT(140)
451 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141)
452 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142)
453 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143)
454 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144)
455 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145)
456 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146)
457 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147)
458 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148)
459 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149)
461 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150)
462 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151)
463 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152)
464 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153)
465 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154)
466 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155)
467 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156)
468 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157)
469 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158)
471 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159)
472 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160)
473 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161)
474 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162)
475 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163)
476 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164)
477 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165)
478 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166)
479 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167)
481 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168)
482 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169)
483 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170)
484 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171)
485 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172)
486 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173)
487 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174)
488 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175)
489 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176)
491 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177)
492 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178)
493 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179)
494 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180)
495 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181)
496 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)
497 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)
498 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184)
499 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)
501 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186)
502 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187)
503 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188)
504 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189)
505 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190)
506 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191)
507 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192)
508 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193)
509 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194)
510 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)
512 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)
513 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)
514 tagOf_PrimOp UnsafeThawArrayOp = ILIT(198)
515 tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199)
516 tagOf_PrimOp SizeofByteArrayOp = ILIT(200)
517 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201)
519 tagOf_PrimOp NewMVarOp = ILIT(202)
520 tagOf_PrimOp TakeMVarOp = ILIT(203)
521 tagOf_PrimOp PutMVarOp = ILIT(204)
522 tagOf_PrimOp SameMVarOp = ILIT(205)
523 tagOf_PrimOp IsEmptyMVarOp = ILIT(206)
524 tagOf_PrimOp MakeForeignObjOp = ILIT(207)
525 tagOf_PrimOp WriteForeignObjOp = ILIT(208)
526 tagOf_PrimOp MkWeakOp = ILIT(209)
527 tagOf_PrimOp DeRefWeakOp = ILIT(210)
528 tagOf_PrimOp FinalizeWeakOp = ILIT(211)
529 tagOf_PrimOp MakeStableNameOp = ILIT(212)
530 tagOf_PrimOp EqStableNameOp = ILIT(213)
531 tagOf_PrimOp StableNameToIntOp = ILIT(214)
532 tagOf_PrimOp MakeStablePtrOp = ILIT(215)
533 tagOf_PrimOp DeRefStablePtrOp = ILIT(216)
534 tagOf_PrimOp EqStablePtrOp = ILIT(217)
535 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218)
536 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219)
537 tagOf_PrimOp SeqOp = ILIT(220)
538 tagOf_PrimOp ParOp = ILIT(221)
539 tagOf_PrimOp ForkOp = ILIT(222)
540 tagOf_PrimOp KillThreadOp = ILIT(223)
541 tagOf_PrimOp YieldOp = ILIT(224)
542 tagOf_PrimOp MyThreadIdOp = ILIT(225)
543 tagOf_PrimOp DelayOp = ILIT(226)
544 tagOf_PrimOp WaitReadOp = ILIT(227)
545 tagOf_PrimOp WaitWriteOp = ILIT(228)
546 tagOf_PrimOp ParGlobalOp = ILIT(229)
547 tagOf_PrimOp ParLocalOp = ILIT(230)
548 tagOf_PrimOp ParAtOp = ILIT(231)
549 tagOf_PrimOp ParAtAbsOp = ILIT(232)
550 tagOf_PrimOp ParAtRelOp = ILIT(233)
551 tagOf_PrimOp ParAtForNowOp = ILIT(234)
552 tagOf_PrimOp CopyableOp = ILIT(235)
553 tagOf_PrimOp NoFollowOp = ILIT(236)
554 tagOf_PrimOp NewMutVarOp = ILIT(237)
555 tagOf_PrimOp ReadMutVarOp = ILIT(238)
556 tagOf_PrimOp WriteMutVarOp = ILIT(239)
557 tagOf_PrimOp SameMutVarOp = ILIT(240)
558 tagOf_PrimOp CatchOp = ILIT(241)
559 tagOf_PrimOp RaiseOp = ILIT(242)
560 tagOf_PrimOp DataToTagOp = ILIT(243)
561 tagOf_PrimOp TagToEnumOp = ILIT(244)
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)
714 NewByteArrayOp CharRep,
715 NewByteArrayOp IntRep,
716 NewByteArrayOp WordRep,
717 NewByteArrayOp AddrRep,
718 NewByteArrayOp FloatRep,
719 NewByteArrayOp DoubleRep,
720 NewByteArrayOp StablePtrRep,
722 SameMutableByteArrayOp,
726 ReadByteArrayOp CharRep,
727 ReadByteArrayOp IntRep,
728 ReadByteArrayOp WordRep,
729 ReadByteArrayOp AddrRep,
730 ReadByteArrayOp FloatRep,
731 ReadByteArrayOp DoubleRep,
732 ReadByteArrayOp StablePtrRep,
733 ReadByteArrayOp Int64Rep,
734 ReadByteArrayOp Word64Rep,
735 WriteByteArrayOp CharRep,
736 WriteByteArrayOp IntRep,
737 WriteByteArrayOp WordRep,
738 WriteByteArrayOp AddrRep,
739 WriteByteArrayOp FloatRep,
740 WriteByteArrayOp DoubleRep,
741 WriteByteArrayOp StablePtrRep,
742 WriteByteArrayOp Int64Rep,
743 WriteByteArrayOp Word64Rep,
744 IndexByteArrayOp CharRep,
745 IndexByteArrayOp IntRep,
746 IndexByteArrayOp WordRep,
747 IndexByteArrayOp AddrRep,
748 IndexByteArrayOp FloatRep,
749 IndexByteArrayOp DoubleRep,
750 IndexByteArrayOp StablePtrRep,
751 IndexByteArrayOp Int64Rep,
752 IndexByteArrayOp Word64Rep,
753 IndexOffForeignObjOp CharRep,
754 IndexOffForeignObjOp AddrRep,
755 IndexOffForeignObjOp IntRep,
756 IndexOffForeignObjOp WordRep,
757 IndexOffForeignObjOp FloatRep,
758 IndexOffForeignObjOp DoubleRep,
759 IndexOffForeignObjOp StablePtrRep,
760 IndexOffForeignObjOp Int64Rep,
761 IndexOffForeignObjOp Word64Rep,
762 IndexOffAddrOp CharRep,
763 IndexOffAddrOp IntRep,
764 IndexOffAddrOp WordRep,
765 IndexOffAddrOp AddrRep,
766 IndexOffAddrOp FloatRep,
767 IndexOffAddrOp DoubleRep,
768 IndexOffAddrOp StablePtrRep,
769 IndexOffAddrOp Int64Rep,
770 IndexOffAddrOp Word64Rep,
771 WriteOffAddrOp CharRep,
772 WriteOffAddrOp IntRep,
773 WriteOffAddrOp WordRep,
774 WriteOffAddrOp AddrRep,
775 WriteOffAddrOp FloatRep,
776 WriteOffAddrOp DoubleRep,
777 WriteOffAddrOp ForeignObjRep,
778 WriteOffAddrOp StablePtrRep,
779 WriteOffAddrOp Int64Rep,
780 WriteOffAddrOp Word64Rep,
782 UnsafeFreezeByteArrayOp,
784 UnsafeThawByteArrayOp,
786 SizeofMutableByteArrayOp,
809 ReallyUnsafePtrEqualityOp,
832 %************************************************************************
834 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
836 %************************************************************************
838 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
839 refer to the primitive operation. The conventional \tr{#}-for-
840 unboxed ops is added on later.
842 The reason for the funny characters in the names is so we do not
843 interfere with the programmer's Haskell name spaces.
845 We use @PrimKinds@ for the ``type'' information, because they're
846 (slightly) more convenient to use than @TyCons@.
849 = Dyadic OccName -- string :: T -> T -> T
851 | Monadic OccName -- string :: T -> T
853 | Compare OccName -- string :: T -> T -> Bool
856 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
861 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
862 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
863 mkCompare str ty = Compare (mkSrcVarOcc str) ty
864 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
869 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
871 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
872 intPrimTy, byteArrayPrimTy] -- second '' pieces
873 an_Integer_and_Int_tys
874 = [intPrimTy, byteArrayPrimTy, -- Integer
877 unboxedPair = mkUnboxedTupleTy 2
878 unboxedTriple = mkUnboxedTupleTy 3
879 unboxedQuadruple = mkUnboxedTupleTy 4
881 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
882 (unboxedPair one_Integer_ty)
884 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
885 (unboxedPair one_Integer_ty)
887 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
888 (unboxedQuadruple two_Integer_tys)
890 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
893 %************************************************************************
895 \subsubsection{Strictness}
897 %************************************************************************
899 Not all primops are strict!
902 primOpStrictness :: PrimOp -> ([Demand], Bool)
903 -- See IdInfo.StrictnessInfo for discussion of what the results
904 -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,
905 -- the list of demands may be infinite!
906 -- Use only the ones you ned.
908 primOpStrictness SeqOp = ([wwStrict], False)
909 -- Seq is strict in its argument; see notes in ConFold.lhs
911 primOpStrictness ParOp = ([wwLazy], False)
912 -- But Par is lazy, to avoid that the sparked thing
913 -- gets evaluted strictly, which it should *not* be
915 primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
917 primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
918 primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
920 primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)
921 primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
923 primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
925 primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
926 primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
928 primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
929 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
930 primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
932 primOpStrictness DataToTagOp = ([wwLazy], False)
934 -- The rest all have primitive-typed arguments
935 primOpStrictness other = (repeat wwPrim, False)
938 %************************************************************************
940 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
942 %************************************************************************
944 @primOpInfo@ gives all essential information (from which everything
945 else, notably a type, can be constructed) for each @PrimOp@.
948 primOpInfo :: PrimOp -> PrimOpInfo
951 There's plenty of this stuff!
954 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
955 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
956 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
957 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
958 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
959 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
961 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
962 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
963 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
964 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
965 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
966 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
968 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
969 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
970 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
971 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
972 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
973 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
975 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
976 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
977 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
978 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
979 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
980 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
982 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
983 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
984 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
985 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
986 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
987 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
989 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
990 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
991 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
992 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
993 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
994 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
998 %************************************************************************
1000 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
1002 %************************************************************************
1005 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
1006 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
1009 %************************************************************************
1011 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
1013 %************************************************************************
1016 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
1017 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
1018 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
1019 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
1020 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
1022 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
1023 primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
1025 primOpInfo IntAddCOp =
1026 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
1027 (unboxedPair [intPrimTy, intPrimTy])
1029 primOpInfo IntSubCOp =
1030 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
1031 (unboxedPair [intPrimTy, intPrimTy])
1033 primOpInfo IntMulCOp =
1034 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
1035 (unboxedPair [intPrimTy, intPrimTy])
1038 %************************************************************************
1040 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1042 %************************************************************************
1044 A @Word#@ is an unsigned @Int#@.
1047 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1048 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1050 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1051 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1052 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1053 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1056 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1058 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1061 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1063 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1065 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1067 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1068 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1071 %************************************************************************
1073 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1075 %************************************************************************
1078 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1079 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1083 %************************************************************************
1085 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1087 %************************************************************************
1089 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1092 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1093 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1094 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1095 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1096 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1098 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1099 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1101 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1102 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1103 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1104 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1105 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1106 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1107 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1108 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1109 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1110 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1111 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1112 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1113 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1116 %************************************************************************
1118 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1120 %************************************************************************
1122 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1125 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1126 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1127 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1128 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1129 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1131 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1132 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1134 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1135 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1137 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1138 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1139 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1140 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1141 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1142 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1143 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1144 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1145 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1146 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1147 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1148 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1149 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1152 %************************************************************************
1154 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1156 %************************************************************************
1159 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1161 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1162 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1163 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1164 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1166 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1167 primOpInfo IntegerCmpIntOp
1168 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1170 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1171 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1173 primOpInfo Integer2IntOp
1174 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1176 primOpInfo Integer2WordOp
1177 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1179 primOpInfo Int2IntegerOp
1180 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1181 (unboxedPair one_Integer_ty)
1183 primOpInfo Word2IntegerOp
1184 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1185 (unboxedPair one_Integer_ty)
1187 primOpInfo Addr2IntegerOp
1188 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1189 (unboxedPair one_Integer_ty)
1191 primOpInfo IntegerToInt64Op
1192 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1194 primOpInfo Int64ToIntegerOp
1195 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1196 (unboxedPair one_Integer_ty)
1198 primOpInfo Word64ToIntegerOp
1199 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1200 (unboxedPair one_Integer_ty)
1202 primOpInfo IntegerToWord64Op
1203 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1206 Decoding of floating-point numbers is sorta Integer-related. Encoding
1207 is done with plain ccalls now (see PrelNumExtra.lhs).
1210 primOpInfo FloatDecodeOp
1211 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1212 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1213 primOpInfo DoubleDecodeOp
1214 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1215 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1218 %************************************************************************
1220 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1222 %************************************************************************
1225 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1226 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1230 primOpInfo NewArrayOp
1232 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1233 state = mkStatePrimTy s
1235 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1236 [intPrimTy, elt, state]
1237 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1239 primOpInfo (NewByteArrayOp kind)
1241 s = alphaTy; s_tv = alphaTyVar
1243 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1244 state = mkStatePrimTy s
1246 mkGenPrimOp op_str [s_tv]
1248 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1250 ---------------------------------------------------------------------------
1253 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1254 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1257 primOpInfo SameMutableArrayOp
1259 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1260 mut_arr_ty = mkMutableArrayPrimTy s elt
1262 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1265 primOpInfo SameMutableByteArrayOp
1267 s = alphaTy; s_tv = alphaTyVar;
1268 mut_arr_ty = mkMutableByteArrayPrimTy s
1270 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1273 ---------------------------------------------------------------------------
1274 -- Primitive arrays of Haskell pointers:
1277 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1278 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1279 indexArray# :: Array# a -> Int# -> (# a #)
1282 primOpInfo ReadArrayOp
1284 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1285 state = mkStatePrimTy s
1287 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1288 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1289 (unboxedPair [state, elt])
1292 primOpInfo WriteArrayOp
1294 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1296 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1297 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1300 primOpInfo IndexArrayOp
1301 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1302 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1303 (mkUnboxedTupleTy 1 [elt])
1305 ---------------------------------------------------------------------------
1306 -- Primitive arrays full of unboxed bytes:
1308 primOpInfo (ReadByteArrayOp kind)
1310 s = alphaTy; s_tv = alphaTyVar
1312 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1313 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1314 state = mkStatePrimTy s
1316 mkGenPrimOp op_str (s_tv:tvs)
1317 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1318 (unboxedPair [state, prim_ty])
1320 primOpInfo (WriteByteArrayOp kind)
1322 s = alphaTy; s_tv = alphaTyVar
1323 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1324 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1326 mkGenPrimOp op_str (s_tv:tvs)
1327 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1330 primOpInfo (IndexByteArrayOp kind)
1332 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1333 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1335 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1337 primOpInfo (IndexOffForeignObjOp kind)
1339 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1340 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1342 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1344 primOpInfo (IndexOffAddrOp kind)
1346 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1347 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1349 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1351 primOpInfo (WriteOffAddrOp kind)
1353 s = alphaTy; s_tv = alphaTyVar
1354 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1355 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1357 mkGenPrimOp op_str (s_tv:tvs)
1358 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1361 ---------------------------------------------------------------------------
1363 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1364 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1365 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1366 unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)
1369 primOpInfo UnsafeFreezeArrayOp
1371 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1372 state = mkStatePrimTy s
1374 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1375 [mkMutableArrayPrimTy s elt, state]
1376 (unboxedPair [state, mkArrayPrimTy elt])
1378 primOpInfo UnsafeFreezeByteArrayOp
1380 s = alphaTy; s_tv = alphaTyVar;
1381 state = mkStatePrimTy s
1383 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1384 [mkMutableByteArrayPrimTy s, state]
1385 (unboxedPair [state, byteArrayPrimTy])
1387 primOpInfo UnsafeThawArrayOp
1389 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1390 state = mkStatePrimTy s
1392 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
1393 [mkArrayPrimTy elt, state]
1394 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1396 primOpInfo UnsafeThawByteArrayOp
1398 s = alphaTy; s_tv = alphaTyVar;
1399 state = mkStatePrimTy s
1401 mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]
1402 [byteArrayPrimTy, state]
1403 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1405 ---------------------------------------------------------------------------
1406 primOpInfo SizeofByteArrayOp
1408 SLIT("sizeofByteArray#") []
1412 primOpInfo SizeofMutableByteArrayOp
1413 = let { s = alphaTy; s_tv = alphaTyVar } in
1415 SLIT("sizeofMutableByteArray#") [s_tv]
1416 [mkMutableByteArrayPrimTy s]
1421 %************************************************************************
1423 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1425 %************************************************************************
1428 primOpInfo NewMutVarOp
1430 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1431 state = mkStatePrimTy s
1433 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1435 (unboxedPair [state, mkMutVarPrimTy s elt])
1437 primOpInfo ReadMutVarOp
1439 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1440 state = mkStatePrimTy s
1442 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1443 [mkMutVarPrimTy s elt, state]
1444 (unboxedPair [state, elt])
1447 primOpInfo WriteMutVarOp
1449 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1451 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1452 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1455 primOpInfo SameMutVarOp
1457 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1458 mut_var_ty = mkMutVarPrimTy s elt
1460 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1464 %************************************************************************
1466 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1468 %************************************************************************
1470 catch :: IO a -> (IOError -> IO a) -> IO a
1471 catch# :: a -> (b -> a) -> a
1476 a = alphaTy; a_tv = alphaTyVar
1477 b = betaTy; b_tv = betaTyVar;
1479 mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
1483 a = alphaTy; a_tv = alphaTyVar
1484 b = betaTy; b_tv = betaTyVar;
1486 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1489 %************************************************************************
1491 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1493 %************************************************************************
1496 primOpInfo NewMVarOp
1498 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1499 state = mkStatePrimTy s
1501 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1502 (unboxedPair [state, mkMVarPrimTy s elt])
1504 primOpInfo TakeMVarOp
1506 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1507 state = mkStatePrimTy s
1509 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1510 [mkMVarPrimTy s elt, state]
1511 (unboxedPair [state, elt])
1513 primOpInfo PutMVarOp
1515 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1517 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1518 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1521 primOpInfo SameMVarOp
1523 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1524 mvar_ty = mkMVarPrimTy s elt
1526 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1528 primOpInfo IsEmptyMVarOp
1530 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1531 state = mkStatePrimTy s
1533 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1534 [mkMVarPrimTy s elt, mkStatePrimTy s]
1535 (unboxedPair [state, intPrimTy])
1539 %************************************************************************
1541 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1543 %************************************************************************
1549 s = alphaTy; s_tv = alphaTyVar
1551 mkGenPrimOp SLIT("delay#") [s_tv]
1552 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1554 primOpInfo WaitReadOp
1556 s = alphaTy; s_tv = alphaTyVar
1558 mkGenPrimOp SLIT("waitRead#") [s_tv]
1559 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1561 primOpInfo WaitWriteOp
1563 s = alphaTy; s_tv = alphaTyVar
1565 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1566 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1569 %************************************************************************
1571 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1573 %************************************************************************
1576 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1578 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1579 [alphaTy, realWorldStatePrimTy]
1580 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1582 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1583 primOpInfo KillThreadOp
1584 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1585 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1586 realWorldStatePrimTy
1588 -- yield# :: State# RealWorld -> State# RealWorld
1590 = mkGenPrimOp SLIT("yield#") []
1591 [realWorldStatePrimTy]
1592 realWorldStatePrimTy
1594 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1595 primOpInfo MyThreadIdOp
1596 = mkGenPrimOp SLIT("myThreadId#") []
1597 [realWorldStatePrimTy]
1598 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1601 ************************************************************************
1603 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1605 %************************************************************************
1608 primOpInfo MakeForeignObjOp
1609 = mkGenPrimOp SLIT("makeForeignObj#") []
1610 [addrPrimTy, realWorldStatePrimTy]
1611 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1613 primOpInfo WriteForeignObjOp
1615 s = alphaTy; s_tv = alphaTyVar
1617 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1618 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1621 ************************************************************************
1623 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1625 %************************************************************************
1627 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1629 mkWeak# :: k -> v -> f -> State# RealWorld
1630 -> (# State# RealWorld, Weak# v #)
1632 In practice, you'll use the higher-level
1634 data Weak v = Weak# v
1635 mkWeak :: k -> v -> IO () -> IO (Weak v)
1639 = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
1640 [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
1641 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1644 The following operation dereferences a weak pointer. The weak pointer
1645 may have been finalized, so the operation returns a result code which
1646 must be inspected before looking at the dereferenced value.
1648 deRefWeak# :: Weak# v -> State# RealWorld ->
1649 (# State# RealWorld, v, Int# #)
1651 Only look at v if the Int# returned is /= 0 !!
1653 The higher-level op is
1655 deRefWeak :: Weak v -> IO (Maybe v)
1658 primOpInfo DeRefWeakOp
1659 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1660 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1661 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1664 Weak pointers can be finalized early by using the finalize# operation:
1666 finalizeWeak# :: Weak# v -> State# RealWorld ->
1667 (# State# RealWorld, Int#, IO () #)
1669 The Int# returned is either
1671 0 if the weak pointer has already been finalized, or it has no
1672 finalizer (the third component is then invalid).
1674 1 if the weak pointer is still alive, with the finalizer returned
1675 as the third component.
1678 primOpInfo FinalizeWeakOp
1679 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1680 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1681 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1682 mkFunTy realWorldStatePrimTy
1683 (unboxedPair [realWorldStatePrimTy,unitTy])])
1686 %************************************************************************
1688 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1690 %************************************************************************
1692 A {\em stable name/pointer} is an index into a table of stable name
1693 entries. Since the garbage collector is told about stable pointers,
1694 it is safe to pass a stable pointer to external systems such as C
1698 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1699 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1700 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1701 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1704 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1705 operation since it doesn't (directly) involve IO operations. The
1706 reason is that if some optimisation pass decided to duplicate calls to
1707 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1708 massive space leak can result. Putting it into the IO monad
1709 prevents this. (Another reason for putting them in a monad is to
1710 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1713 An important property of stable pointers is that if you call
1714 makeStablePtr# twice on the same object you get the same stable
1717 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1718 besides, it's not likely to be used from Haskell) so it's not a
1721 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1726 A stable name is like a stable pointer, but with three important differences:
1728 (a) You can't deRef one to get back to the original object.
1729 (b) You can convert one to an Int.
1730 (c) You don't need to 'freeStableName'
1732 The existence of a stable name doesn't guarantee to keep the object it
1733 points to alive (unlike a stable pointer), hence (a).
1737 (a) makeStableName always returns the same value for a given
1738 object (same as stable pointers).
1740 (b) if two stable names are equal, it implies that the objects
1741 from which they were created were the same.
1743 (c) stableNameToInt always returns the same Int for a given
1747 primOpInfo MakeStablePtrOp
1748 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1749 [alphaTy, realWorldStatePrimTy]
1750 (unboxedPair [realWorldStatePrimTy,
1751 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1753 primOpInfo DeRefStablePtrOp
1754 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1755 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1756 (unboxedPair [realWorldStatePrimTy, alphaTy])
1758 primOpInfo EqStablePtrOp
1759 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1760 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1763 primOpInfo MakeStableNameOp
1764 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1765 [alphaTy, realWorldStatePrimTy]
1766 (unboxedPair [realWorldStatePrimTy,
1767 mkTyConApp stableNamePrimTyCon [alphaTy]])
1769 primOpInfo EqStableNameOp
1770 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1771 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1774 primOpInfo StableNameToIntOp
1775 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1776 [mkStableNamePrimTy alphaTy]
1780 %************************************************************************
1782 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1784 %************************************************************************
1786 [Alastair Reid is to blame for this!]
1788 These days, (Glasgow) Haskell seems to have a bit of everything from
1789 other languages: strict operations, mutable variables, sequencing,
1790 pointers, etc. About the only thing left is LISP's ability to test
1791 for pointer equality. So, let's add it in!
1794 reallyUnsafePtrEquality :: a -> a -> Int#
1797 which tests any two closures (of the same type) to see if they're the
1798 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1799 difficulties of trying to box up the result.)
1801 NB This is {\em really unsafe\/} because even something as trivial as
1802 a garbage collection might change the answer by removing indirections.
1803 Still, no-one's forcing you to use it. If you're worried about little
1804 things like loss of referential transparency, you might like to wrap
1805 it all up in a monad-like thing as John O'Donnell and John Hughes did
1806 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1809 I'm thinking of using it to speed up a critical equality test in some
1810 graphics stuff in a context where the possibility of saying that
1811 denotationally equal things aren't isn't a problem (as long as it
1812 doesn't happen too often.) ADR
1814 To Will: Jim said this was already in, but I can't see it so I'm
1815 adding it. Up to you whether you add it. (Note that this could have
1816 been readily implemented using a @veryDangerousCCall@ before they were
1820 primOpInfo ReallyUnsafePtrEqualityOp
1821 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1822 [alphaTy, alphaTy] intPrimTy
1825 %************************************************************************
1827 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1829 %************************************************************************
1832 primOpInfo SeqOp -- seq# :: a -> Int#
1833 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1835 primOpInfo ParOp -- par# :: a -> Int#
1836 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1840 -- HWL: The first 4 Int# in all par... annotations denote:
1841 -- name, granularity info, size of result, degree of parallelism
1842 -- Same structure as _seq_ i.e. returns Int#
1843 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1844 -- `the processor containing the expression v'; it is not evaluated
1846 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1847 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1849 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1850 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1852 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1853 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1855 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1856 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1858 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1859 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1861 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1862 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1864 primOpInfo CopyableOp -- copyable# :: a -> Int#
1865 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1867 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1868 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1871 %************************************************************************
1873 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1875 %************************************************************************
1878 primOpInfo (CCallOp _ _ _ _)
1879 = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
1882 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1883 = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
1885 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1889 %************************************************************************
1891 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1893 %************************************************************************
1895 These primops are pretty wierd.
1897 dataToTag# :: a -> Int (arg must be an evaluated data type)
1898 tagToEnum# :: Int -> a (result type must be an enumerated type)
1900 The constraints aren't currently checked by the front end, but the
1901 code generator will fall over if they aren't satisfied.
1904 primOpInfo DataToTagOp
1905 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1907 primOpInfo TagToEnumOp
1908 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1911 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1915 %************************************************************************
1917 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1919 %************************************************************************
1921 Some PrimOps need to be called out-of-line because they either need to
1922 perform a heap check or they block.
1935 NewByteArrayOp _ -> True
1936 IntegerAddOp -> True
1937 IntegerSubOp -> True
1938 IntegerMulOp -> True
1939 IntegerGcdOp -> True
1940 IntegerQuotRemOp -> True
1941 IntegerDivModOp -> True
1942 Int2IntegerOp -> True
1943 Word2IntegerOp -> True
1944 Addr2IntegerOp -> True
1945 Word64ToIntegerOp -> True
1946 Int64ToIntegerOp -> True
1947 FloatDecodeOp -> True
1948 DoubleDecodeOp -> True
1950 FinalizeWeakOp -> True
1951 MakeStableNameOp -> True
1952 MakeForeignObjOp -> True
1956 KillThreadOp -> True
1958 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
1959 -- the next one doesn't perform any heap checks,
1960 -- but it is of such an esoteric nature that
1961 -- it is done out-of-line rather than require
1962 -- the NCG to implement it.
1963 UnsafeThawArrayOp -> True
1967 Sometimes we may choose to execute a PrimOp even though it isn't
1968 certain that its result will be required; ie execute them
1969 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1970 this is OK, because PrimOps are usually cheap, but it isn't OK for
1971 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1973 See also @primOpIsCheap@ (below).
1975 PrimOps that have side effects also should not be executed speculatively
1976 or by data dependencies.
1979 primOpOkForSpeculation :: PrimOp -> Bool
1980 primOpOkForSpeculation op
1981 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1984 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1985 WARNING), we just borrow some other predicates for a
1986 what-should-be-good-enough test. "Cheap" means willing to call it more
1987 than once. Evaluation order is unaffected.
1990 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
1993 primOpIsDupable means that the use of the primop is small enough to
1994 duplicate into different case branches. See CoreUtils.exprIsDupable.
1997 primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc
1998 -- If the ccall can't GC then the call is pretty cheap, and
1999 -- we're happy to duplicate
2000 primOpIsDupable op = not (primOpOutOfLine op)
2005 primOpCanFail :: PrimOp -> Bool
2007 primOpCanFail IntQuotOp = True -- Divide by zero
2008 primOpCanFail IntRemOp = True -- Divide by zero
2011 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2012 primOpCanFail IntegerDivModOp = True -- Divide by zero
2014 -- Float. ToDo: tan? tanh?
2015 primOpCanFail FloatDivOp = True -- Divide by zero
2016 primOpCanFail FloatLogOp = True -- Log of zero
2017 primOpCanFail FloatAsinOp = True -- Arg out of domain
2018 primOpCanFail FloatAcosOp = True -- Arg out of domain
2020 -- Double. ToDo: tan? tanh?
2021 primOpCanFail DoubleDivOp = True -- Divide by zero
2022 primOpCanFail DoubleLogOp = True -- Log of zero
2023 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2024 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2026 primOpCanFail other_op = False
2029 And some primops have side-effects and so, for example, must not be
2033 primOpHasSideEffects :: PrimOp -> Bool
2035 primOpHasSideEffects TakeMVarOp = True
2036 primOpHasSideEffects DelayOp = True
2037 primOpHasSideEffects WaitReadOp = True
2038 primOpHasSideEffects WaitWriteOp = True
2040 primOpHasSideEffects ParOp = True
2041 primOpHasSideEffects ForkOp = True
2042 primOpHasSideEffects KillThreadOp = True
2043 primOpHasSideEffects YieldOp = True
2044 primOpHasSideEffects SeqOp = True
2046 primOpHasSideEffects MakeForeignObjOp = True
2047 primOpHasSideEffects WriteForeignObjOp = True
2048 primOpHasSideEffects MkWeakOp = True
2049 primOpHasSideEffects DeRefWeakOp = True
2050 primOpHasSideEffects FinalizeWeakOp = True
2051 primOpHasSideEffects MakeStablePtrOp = True
2052 primOpHasSideEffects MakeStableNameOp = True
2053 primOpHasSideEffects EqStablePtrOp = True -- SOF
2054 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2056 primOpHasSideEffects ParGlobalOp = True
2057 primOpHasSideEffects ParLocalOp = True
2058 primOpHasSideEffects ParAtOp = True
2059 primOpHasSideEffects ParAtAbsOp = True
2060 primOpHasSideEffects ParAtRelOp = True
2061 primOpHasSideEffects ParAtForNowOp = True
2062 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2063 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2066 primOpHasSideEffects (CCallOp _ _ _ _) = True
2068 primOpHasSideEffects other = False
2071 Inline primitive operations that perform calls need wrappers to save
2072 any live variables that are stored in caller-saves registers.
2075 primOpNeedsWrapper :: PrimOp -> Bool
2077 primOpNeedsWrapper (CCallOp _ _ _ _) = True
2079 primOpNeedsWrapper Integer2IntOp = True
2080 primOpNeedsWrapper Integer2WordOp = True
2081 primOpNeedsWrapper IntegerCmpOp = True
2082 primOpNeedsWrapper IntegerCmpIntOp = True
2084 primOpNeedsWrapper FloatExpOp = True
2085 primOpNeedsWrapper FloatLogOp = True
2086 primOpNeedsWrapper FloatSqrtOp = True
2087 primOpNeedsWrapper FloatSinOp = True
2088 primOpNeedsWrapper FloatCosOp = True
2089 primOpNeedsWrapper FloatTanOp = True
2090 primOpNeedsWrapper FloatAsinOp = True
2091 primOpNeedsWrapper FloatAcosOp = True
2092 primOpNeedsWrapper FloatAtanOp = True
2093 primOpNeedsWrapper FloatSinhOp = True
2094 primOpNeedsWrapper FloatCoshOp = True
2095 primOpNeedsWrapper FloatTanhOp = True
2096 primOpNeedsWrapper FloatPowerOp = True
2098 primOpNeedsWrapper DoubleExpOp = True
2099 primOpNeedsWrapper DoubleLogOp = True
2100 primOpNeedsWrapper DoubleSqrtOp = True
2101 primOpNeedsWrapper DoubleSinOp = True
2102 primOpNeedsWrapper DoubleCosOp = True
2103 primOpNeedsWrapper DoubleTanOp = True
2104 primOpNeedsWrapper DoubleAsinOp = True
2105 primOpNeedsWrapper DoubleAcosOp = True
2106 primOpNeedsWrapper DoubleAtanOp = True
2107 primOpNeedsWrapper DoubleSinhOp = True
2108 primOpNeedsWrapper DoubleCoshOp = True
2109 primOpNeedsWrapper DoubleTanhOp = True
2110 primOpNeedsWrapper DoublePowerOp = True
2112 primOpNeedsWrapper MakeStableNameOp = True
2113 primOpNeedsWrapper DeRefStablePtrOp = True
2115 primOpNeedsWrapper DelayOp = True
2116 primOpNeedsWrapper WaitReadOp = True
2117 primOpNeedsWrapper WaitWriteOp = True
2119 primOpNeedsWrapper other_op = False
2123 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2125 = case (primOpInfo op) of
2126 Dyadic occ ty -> dyadic_fun_ty ty
2127 Monadic occ ty -> monadic_fun_ty ty
2128 Compare occ ty -> compare_fun_ty ty
2130 GenPrimOp occ tyvars arg_tys res_ty ->
2131 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2133 mkPrimOpIdName :: PrimOp -> Id -> Name
2134 -- Make the name for the PrimOp's Id
2135 -- We have to pass in the Id itself because it's a WiredInId
2136 -- and hence recursive
2137 mkPrimOpIdName op id
2138 = mkWiredInIdName key pREL_GHC occ_name id
2140 occ_name = primOpOcc op
2141 key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
2144 primOpRdrName :: PrimOp -> RdrName
2145 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2147 primOpOcc :: PrimOp -> OccName
2148 primOpOcc op = case (primOpInfo op) of
2150 Monadic occ _ -> occ
2151 Compare occ _ -> occ
2152 GenPrimOp occ _ _ _ -> occ
2154 -- primOpSig is like primOpType but gives the result split apart:
2155 -- (type variables, argument types, result type)
2157 primOpSig :: PrimOp -> ([TyVar],[Type],Type)
2159 = case (primOpInfo op) of
2160 Monadic occ ty -> ([], [ty], ty )
2161 Dyadic occ ty -> ([], [ty,ty], ty )
2162 Compare occ ty -> ([], [ty,ty], boolTy)
2163 GenPrimOp occ tyvars arg_tys res_ty
2164 -> (tyvars, arg_tys, res_ty)
2166 -- primOpUsg is like primOpSig but the types it yields are the
2167 -- appropriate sigma (i.e., usage-annotated) types,
2168 -- as required by the UsageSP inference.
2170 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2174 -- Refer to comment by `otherwise' clause; we need consider here
2175 -- *only* primops that have arguments or results containing Haskell
2176 -- pointers (things that are pointed). Unpointed values are
2177 -- irrelevant to the usage analysis. The issue is whether pointed
2178 -- values may be entered or duplicated by the primop.
2180 -- Remember that primops are *never* partially applied.
2182 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2183 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2184 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2185 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2186 IndexArrayOp -> mangle [mkM, mkP ] mkM
2187 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2188 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2190 NewMutVarOp -> mangle [mkM, mkP ] mkM
2191 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2192 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2193 SameMutVarOp -> mangle [mkP, mkP ] mkM
2195 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2196 mangle [mkM, mkM . (inFun mkM mkM)] mkM
2197 -- might use caught action multiply
2198 RaiseOp -> mangle [mkM ] mkM
2200 NewMVarOp -> mangle [mkP ] mkR
2201 TakeMVarOp -> mangle [mkM, mkP ] mkM
2202 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2203 SameMVarOp -> mangle [mkP, mkP ] mkM
2204 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2206 ForkOp -> mangle [mkO, mkP ] mkR
2207 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2209 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2210 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2211 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2213 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2214 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2215 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2216 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2217 EqStableNameOp -> mangle [mkP, mkP ] mkR
2218 StableNameToIntOp -> mangle [mkP ] mkR
2220 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2222 SeqOp -> mangle [mkO ] mkR
2223 ParOp -> mangle [mkO ] mkR
2224 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2225 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2226 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2227 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2228 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2229 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2230 CopyableOp -> mangle [mkZ ] mkR
2231 NoFollowOp -> mangle [mkZ ] mkR
2233 CCallOp _ _ _ _ -> mangle [ ] mkM
2235 -- Things with no Haskell pointers inside: in actuality, usages are
2236 -- irrelevant here (hence it doesn't matter that some of these
2237 -- apparently permit duplication; since such arguments are never
2238 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2239 -- except insofar as it propagates to infect other values that *are*
2242 otherwise -> nomangle
2244 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2245 mkO = mkUsgTy UsOnce -- pointed argument used once
2246 mkM = mkUsgTy UsMany -- pointed argument used multiply
2247 mkP = mkUsgTy UsOnce -- unpointed argument
2248 mkR = mkUsgTy UsMany -- unpointed result
2250 (tyvars, arg_tys, res_ty)
2253 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2255 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2257 inFun f g ty = case splitFunTy_maybe ty of
2258 Just (a,b) -> mkFunTy (f a) (g b)
2259 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2261 inUB fs ty = case splitTyConApp_maybe ty of
2262 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
2263 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
2265 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2269 data PrimOpResultInfo
2270 = ReturnsPrim PrimRep
2273 -- Some PrimOps need not return a manifest primitive or algebraic value
2274 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2275 -- be out of line, or the code generator won't work.
2277 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2278 getPrimOpResultInfo op
2279 = case (primOpInfo op) of
2280 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2281 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2282 Compare _ ty -> ReturnsAlg boolTyCon
2283 GenPrimOp _ _ _ ty ->
2284 let rep = typePrimRep ty in
2286 PtrRep -> case splitAlgTyConApp_maybe ty of
2287 Nothing -> panic "getPrimOpResultInfo"
2288 Just (tc,_,_) -> ReturnsAlg tc
2289 other -> ReturnsPrim other
2291 isCompareOp :: PrimOp -> Bool
2293 = case primOpInfo op of
2298 The commutable ops are those for which we will try to move constants
2299 to the right hand side for strength reduction.
2302 commutableOp :: PrimOp -> Bool
2304 commutableOp CharEqOp = True
2305 commutableOp CharNeOp = True
2306 commutableOp IntAddOp = True
2307 commutableOp IntMulOp = True
2308 commutableOp AndOp = True
2309 commutableOp OrOp = True
2310 commutableOp XorOp = True
2311 commutableOp IntEqOp = True
2312 commutableOp IntNeOp = True
2313 commutableOp IntegerAddOp = True
2314 commutableOp IntegerMulOp = True
2315 commutableOp IntegerGcdOp = True
2316 commutableOp FloatAddOp = True
2317 commutableOp FloatMulOp = True
2318 commutableOp FloatEqOp = True
2319 commutableOp FloatNeOp = True
2320 commutableOp DoubleAddOp = True
2321 commutableOp DoubleMulOp = True
2322 commutableOp DoubleEqOp = True
2323 commutableOp DoubleNeOp = True
2324 commutableOp _ = False
2329 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2330 -- CharRep --> ([], Char#)
2331 -- StablePtrRep --> ([a], StablePtr# a)
2332 mkPrimTyApp tvs kind
2333 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2335 tycon = primRepTyCon kind
2336 forall_tvs = take (tyConArity tycon) tvs
2338 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2339 monadic_fun_ty ty = mkFunTy ty ty
2340 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2345 pprPrimOp :: PrimOp -> SDoc
2347 pprPrimOp (CCallOp fun is_casm may_gc cconv)
2349 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2352 | is_casm && may_gc = "casm_GC ``"
2353 | is_casm = "casm ``"
2354 | may_gc = "ccall_GC "
2355 | otherwise = "ccall "
2358 | is_casm = text "''"
2363 Right _ -> text "dyn_"
2368 Right _ -> text "\"\""
2372 hcat [ ifPprDebug callconv
2373 , text "__", ppr_dyn
2374 , text before , ppr_fun , after]
2377 = getPprStyle $ \ sty ->
2378 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2379 ptext SLIT("PrelGHC.") <> pprOccName occ
2383 occ = primOpOcc other_op