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,
15 primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
18 getPrimOpResultInfo, PrimOpResultInfo(..),
22 CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp
25 #include "HsVersions.h"
27 import PrimRep -- most of it
31 import Demand ( Demand, wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
32 import Var ( TyVar, Id )
33 import CallConv ( CallConv, pprCallConv )
34 import PprType ( pprParendType )
35 import Name ( Name, mkWiredInIdName )
36 import RdrName ( RdrName, mkRdrQual )
37 import OccName ( OccName, pprOccName, mkSrcVarOcc )
38 import TyCon ( TyCon, tyConArity )
39 import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
40 mkTyConTy, mkTyConApp, typePrimRep,mkTyVarTy,
41 splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
44 import Unique ( Unique, mkPrimOpIdUnique )
45 import BasicTypes ( Arity )
46 import PrelMods ( pREL_GHC, pREL_GHC_Name )
48 import Util ( assoc, zipWithEqual )
49 import GlaExts ( Int(..), Int#, (==#) )
52 %************************************************************************
54 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
56 %************************************************************************
58 These are in \tr{state-interface.verb} order.
62 -- dig the FORTRAN/C influence on the names...
66 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
67 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
68 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
69 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
70 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
71 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
77 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
79 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
86 | WordQuotOp | WordRemOp
87 | AndOp | OrOp | NotOp | XorOp
88 | SllOp | SrlOp -- shift {left,right} {logical}
89 | Int2WordOp | Word2IntOp -- casts
92 | Int2AddrOp | Addr2IntOp -- casts
94 -- Float#-related ops:
95 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
96 | Float2IntOp | Int2FloatOp
98 | FloatExpOp | FloatLogOp | FloatSqrtOp
99 | FloatSinOp | FloatCosOp | FloatTanOp
100 | FloatAsinOp | FloatAcosOp | FloatAtanOp
101 | FloatSinhOp | FloatCoshOp | FloatTanhOp
102 -- not all machines have these available conveniently:
103 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
104 | FloatPowerOp -- ** op
106 -- Double#-related ops:
107 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
108 | Double2IntOp | Int2DoubleOp
109 | Double2FloatOp | Float2DoubleOp
111 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
112 | DoubleSinOp | DoubleCosOp | DoubleTanOp
113 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
114 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
115 -- not all machines have these available conveniently:
116 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
117 | DoublePowerOp -- ** op
119 -- Integer (and related...) ops:
120 -- slightly weird -- to match GMP package.
121 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
122 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
123 | IntegerIntGcdOp | IntegerDivExactOp
124 | IntegerQuotOp | IntegerRemOp
129 | Integer2IntOp | Integer2WordOp
130 | Int2IntegerOp | Word2IntegerOp
132 -- casting to/from Integer and 64-bit (un)signed quantities.
133 | IntegerToInt64Op | Int64ToIntegerOp
134 | IntegerToWord64Op | Word64ToIntegerOp
140 -- primitive ops for primitive arrays
143 | NewByteArrayOp PrimRep
146 | SameMutableByteArrayOp
148 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
150 | ReadByteArrayOp PrimRep
151 | WriteByteArrayOp PrimRep
152 | IndexByteArrayOp PrimRep
153 | ReadOffAddrOp PrimRep
154 | WriteOffAddrOp PrimRep
155 | IndexOffAddrOp PrimRep
156 -- PrimRep can be one of :
157 -- {Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep.
158 -- This is just a cheesy encoding of a bunch of ops.
159 -- Note that ForeignObjRep is not included -- the only way of
160 -- creating a ForeignObj is with a ccall or casm.
161 | IndexOffForeignObjOp PrimRep
163 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
165 | SizeofByteArrayOp | SizeofMutableByteArrayOp
183 | BlockAsyncExceptionsOp
184 | UnblockAsyncExceptionsOp
207 -- Operation to test two closure addresses for equality (yes really!)
208 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
209 | ReallyUnsafePtrEqualityOp
224 -- more parallel stuff
225 | ParGlobalOp -- named global par
226 | ParLocalOp -- named local par
227 | ParAtOp -- specifies destination of local par
228 | ParAtAbsOp -- specifies destination of local par (abs processor)
229 | ParAtRelOp -- specifies destination of local par (rel processor)
230 | ParAtForNowOp -- specifies initial destination of global par
231 | CopyableOp -- marks copyable code
232 | NoFollowOp -- marks non-followup expression
239 Used for the Ord instance
242 primOpTag :: PrimOp -> Int
243 primOpTag op = IBOX( tagOf_PrimOp op )
245 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
246 tagOf_PrimOp CharGeOp = ILIT( 2)
247 tagOf_PrimOp CharEqOp = ILIT( 3)
248 tagOf_PrimOp CharNeOp = ILIT( 4)
249 tagOf_PrimOp CharLtOp = ILIT( 5)
250 tagOf_PrimOp CharLeOp = ILIT( 6)
251 tagOf_PrimOp IntGtOp = ILIT( 7)
252 tagOf_PrimOp IntGeOp = ILIT( 8)
253 tagOf_PrimOp IntEqOp = ILIT( 9)
254 tagOf_PrimOp IntNeOp = ILIT( 10)
255 tagOf_PrimOp IntLtOp = ILIT( 11)
256 tagOf_PrimOp IntLeOp = ILIT( 12)
257 tagOf_PrimOp WordGtOp = ILIT( 13)
258 tagOf_PrimOp WordGeOp = ILIT( 14)
259 tagOf_PrimOp WordEqOp = ILIT( 15)
260 tagOf_PrimOp WordNeOp = ILIT( 16)
261 tagOf_PrimOp WordLtOp = ILIT( 17)
262 tagOf_PrimOp WordLeOp = ILIT( 18)
263 tagOf_PrimOp AddrGtOp = ILIT( 19)
264 tagOf_PrimOp AddrGeOp = ILIT( 20)
265 tagOf_PrimOp AddrEqOp = ILIT( 21)
266 tagOf_PrimOp AddrNeOp = ILIT( 22)
267 tagOf_PrimOp AddrLtOp = ILIT( 23)
268 tagOf_PrimOp AddrLeOp = ILIT( 24)
269 tagOf_PrimOp FloatGtOp = ILIT( 25)
270 tagOf_PrimOp FloatGeOp = ILIT( 26)
271 tagOf_PrimOp FloatEqOp = ILIT( 27)
272 tagOf_PrimOp FloatNeOp = ILIT( 28)
273 tagOf_PrimOp FloatLtOp = ILIT( 29)
274 tagOf_PrimOp FloatLeOp = ILIT( 30)
275 tagOf_PrimOp DoubleGtOp = ILIT( 31)
276 tagOf_PrimOp DoubleGeOp = ILIT( 32)
277 tagOf_PrimOp DoubleEqOp = ILIT( 33)
278 tagOf_PrimOp DoubleNeOp = ILIT( 34)
279 tagOf_PrimOp DoubleLtOp = ILIT( 35)
280 tagOf_PrimOp DoubleLeOp = ILIT( 36)
281 tagOf_PrimOp OrdOp = ILIT( 37)
282 tagOf_PrimOp ChrOp = ILIT( 38)
283 tagOf_PrimOp IntAddOp = ILIT( 39)
284 tagOf_PrimOp IntSubOp = ILIT( 40)
285 tagOf_PrimOp IntMulOp = ILIT( 41)
286 tagOf_PrimOp IntQuotOp = ILIT( 42)
287 tagOf_PrimOp IntGcdOp = ILIT( 43)
288 tagOf_PrimOp IntRemOp = ILIT( 44)
289 tagOf_PrimOp IntNegOp = ILIT( 45)
290 tagOf_PrimOp WordQuotOp = ILIT( 47)
291 tagOf_PrimOp WordRemOp = ILIT( 48)
292 tagOf_PrimOp AndOp = ILIT( 49)
293 tagOf_PrimOp OrOp = ILIT( 50)
294 tagOf_PrimOp NotOp = ILIT( 51)
295 tagOf_PrimOp XorOp = ILIT( 52)
296 tagOf_PrimOp SllOp = ILIT( 53)
297 tagOf_PrimOp SrlOp = ILIT( 54)
298 tagOf_PrimOp ISllOp = ILIT( 55)
299 tagOf_PrimOp ISraOp = ILIT( 56)
300 tagOf_PrimOp ISrlOp = ILIT( 57)
301 tagOf_PrimOp IntAddCOp = ILIT( 58)
302 tagOf_PrimOp IntSubCOp = ILIT( 59)
303 tagOf_PrimOp IntMulCOp = ILIT( 60)
304 tagOf_PrimOp Int2WordOp = ILIT( 61)
305 tagOf_PrimOp Word2IntOp = ILIT( 62)
306 tagOf_PrimOp Int2AddrOp = ILIT( 63)
307 tagOf_PrimOp Addr2IntOp = ILIT( 64)
308 tagOf_PrimOp FloatAddOp = ILIT( 65)
309 tagOf_PrimOp FloatSubOp = ILIT( 66)
310 tagOf_PrimOp FloatMulOp = ILIT( 67)
311 tagOf_PrimOp FloatDivOp = ILIT( 68)
312 tagOf_PrimOp FloatNegOp = ILIT( 69)
313 tagOf_PrimOp Float2IntOp = ILIT( 70)
314 tagOf_PrimOp Int2FloatOp = ILIT( 71)
315 tagOf_PrimOp FloatExpOp = ILIT( 72)
316 tagOf_PrimOp FloatLogOp = ILIT( 73)
317 tagOf_PrimOp FloatSqrtOp = ILIT( 74)
318 tagOf_PrimOp FloatSinOp = ILIT( 75)
319 tagOf_PrimOp FloatCosOp = ILIT( 76)
320 tagOf_PrimOp FloatTanOp = ILIT( 77)
321 tagOf_PrimOp FloatAsinOp = ILIT( 78)
322 tagOf_PrimOp FloatAcosOp = ILIT( 79)
323 tagOf_PrimOp FloatAtanOp = ILIT( 80)
324 tagOf_PrimOp FloatSinhOp = ILIT( 81)
325 tagOf_PrimOp FloatCoshOp = ILIT( 82)
326 tagOf_PrimOp FloatTanhOp = ILIT( 83)
327 tagOf_PrimOp FloatPowerOp = ILIT( 84)
328 tagOf_PrimOp DoubleAddOp = ILIT( 85)
329 tagOf_PrimOp DoubleSubOp = ILIT( 86)
330 tagOf_PrimOp DoubleMulOp = ILIT( 87)
331 tagOf_PrimOp DoubleDivOp = ILIT( 88)
332 tagOf_PrimOp DoubleNegOp = ILIT( 89)
333 tagOf_PrimOp Double2IntOp = ILIT( 90)
334 tagOf_PrimOp Int2DoubleOp = ILIT( 91)
335 tagOf_PrimOp Double2FloatOp = ILIT( 92)
336 tagOf_PrimOp Float2DoubleOp = ILIT( 93)
337 tagOf_PrimOp DoubleExpOp = ILIT( 94)
338 tagOf_PrimOp DoubleLogOp = ILIT( 95)
339 tagOf_PrimOp DoubleSqrtOp = ILIT( 96)
340 tagOf_PrimOp DoubleSinOp = ILIT( 97)
341 tagOf_PrimOp DoubleCosOp = ILIT( 98)
342 tagOf_PrimOp DoubleTanOp = ILIT( 99)
343 tagOf_PrimOp DoubleAsinOp = ILIT(100)
344 tagOf_PrimOp DoubleAcosOp = ILIT(101)
345 tagOf_PrimOp DoubleAtanOp = ILIT(102)
346 tagOf_PrimOp DoubleSinhOp = ILIT(103)
347 tagOf_PrimOp DoubleCoshOp = ILIT(104)
348 tagOf_PrimOp DoubleTanhOp = ILIT(105)
349 tagOf_PrimOp DoublePowerOp = ILIT(106)
350 tagOf_PrimOp IntegerAddOp = ILIT(107)
351 tagOf_PrimOp IntegerSubOp = ILIT(108)
352 tagOf_PrimOp IntegerMulOp = ILIT(109)
353 tagOf_PrimOp IntegerGcdOp = ILIT(110)
354 tagOf_PrimOp IntegerIntGcdOp = ILIT(111)
355 tagOf_PrimOp IntegerDivExactOp = ILIT(112)
356 tagOf_PrimOp IntegerQuotOp = ILIT(113)
357 tagOf_PrimOp IntegerRemOp = ILIT(114)
358 tagOf_PrimOp IntegerQuotRemOp = ILIT(115)
359 tagOf_PrimOp IntegerDivModOp = ILIT(116)
360 tagOf_PrimOp IntegerNegOp = ILIT(117)
361 tagOf_PrimOp IntegerCmpOp = ILIT(118)
362 tagOf_PrimOp IntegerCmpIntOp = ILIT(119)
363 tagOf_PrimOp Integer2IntOp = ILIT(120)
364 tagOf_PrimOp Integer2WordOp = ILIT(121)
365 tagOf_PrimOp Int2IntegerOp = ILIT(122)
366 tagOf_PrimOp Word2IntegerOp = ILIT(123)
367 tagOf_PrimOp Addr2IntegerOp = ILIT(125)
368 tagOf_PrimOp IntegerToInt64Op = ILIT(127)
369 tagOf_PrimOp Int64ToIntegerOp = ILIT(128)
370 tagOf_PrimOp IntegerToWord64Op = ILIT(129)
371 tagOf_PrimOp Word64ToIntegerOp = ILIT(130)
372 tagOf_PrimOp FloatDecodeOp = ILIT(131)
373 tagOf_PrimOp DoubleDecodeOp = ILIT(132)
374 tagOf_PrimOp NewArrayOp = ILIT(133)
375 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134)
376 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135)
377 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136)
378 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137)
379 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138)
380 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139)
381 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140)
382 tagOf_PrimOp SameMutableArrayOp = ILIT(141)
383 tagOf_PrimOp SameMutableByteArrayOp = ILIT(142)
384 tagOf_PrimOp ReadArrayOp = ILIT(143)
385 tagOf_PrimOp WriteArrayOp = ILIT(144)
386 tagOf_PrimOp IndexArrayOp = ILIT(145)
387 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146)
388 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147)
389 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148)
390 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149)
391 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150)
392 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151)
393 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152)
394 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153)
395 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154)
396 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155)
397 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156)
398 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157)
399 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158)
400 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159)
401 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160)
402 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161)
403 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162)
404 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163)
405 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164)
406 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165)
407 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166)
408 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167)
409 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168)
410 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169)
411 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170)
412 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171)
413 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172)
414 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173)
415 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174)
416 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175)
417 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176)
418 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177)
419 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178)
420 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179)
421 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180)
422 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181)
423 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182)
424 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183)
425 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184)
426 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185)
427 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186)
428 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
429 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
430 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189)
431 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
432 tagOf_PrimOp (ReadOffAddrOp CharRep) = ILIT(191)
433 tagOf_PrimOp (ReadOffAddrOp IntRep) = ILIT(192)
434 tagOf_PrimOp (ReadOffAddrOp WordRep) = ILIT(193)
435 tagOf_PrimOp (ReadOffAddrOp AddrRep) = ILIT(194)
436 tagOf_PrimOp (ReadOffAddrOp FloatRep) = ILIT(195)
437 tagOf_PrimOp (ReadOffAddrOp DoubleRep) = ILIT(196)
438 tagOf_PrimOp (ReadOffAddrOp StablePtrRep) = ILIT(197)
439 tagOf_PrimOp (ReadOffAddrOp ForeignObjRep) = ILIT(198)
440 tagOf_PrimOp (ReadOffAddrOp Int64Rep) = ILIT(199)
441 tagOf_PrimOp (ReadOffAddrOp Word64Rep) = ILIT(200)
442 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(201)
443 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(202)
444 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(203)
445 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(205)
446 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(206)
447 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(207)
448 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(208)
449 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(209)
450 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(210)
451 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(211)
452 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(212)
453 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(213)
454 tagOf_PrimOp UnsafeThawArrayOp = ILIT(214)
455 tagOf_PrimOp SizeofByteArrayOp = ILIT(215)
456 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(216)
457 tagOf_PrimOp NewMVarOp = ILIT(217)
458 tagOf_PrimOp TakeMVarOp = ILIT(218)
459 tagOf_PrimOp PutMVarOp = ILIT(219)
460 tagOf_PrimOp SameMVarOp = ILIT(220)
461 tagOf_PrimOp IsEmptyMVarOp = ILIT(221)
462 tagOf_PrimOp MakeForeignObjOp = ILIT(222)
463 tagOf_PrimOp WriteForeignObjOp = ILIT(223)
464 tagOf_PrimOp MkWeakOp = ILIT(224)
465 tagOf_PrimOp DeRefWeakOp = ILIT(225)
466 tagOf_PrimOp FinalizeWeakOp = ILIT(226)
467 tagOf_PrimOp MakeStableNameOp = ILIT(227)
468 tagOf_PrimOp EqStableNameOp = ILIT(228)
469 tagOf_PrimOp StableNameToIntOp = ILIT(229)
470 tagOf_PrimOp MakeStablePtrOp = ILIT(230)
471 tagOf_PrimOp DeRefStablePtrOp = ILIT(231)
472 tagOf_PrimOp EqStablePtrOp = ILIT(232)
473 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(234)
474 tagOf_PrimOp SeqOp = ILIT(235)
475 tagOf_PrimOp ParOp = ILIT(236)
476 tagOf_PrimOp ForkOp = ILIT(237)
477 tagOf_PrimOp KillThreadOp = ILIT(238)
478 tagOf_PrimOp YieldOp = ILIT(239)
479 tagOf_PrimOp MyThreadIdOp = ILIT(240)
480 tagOf_PrimOp DelayOp = ILIT(241)
481 tagOf_PrimOp WaitReadOp = ILIT(242)
482 tagOf_PrimOp WaitWriteOp = ILIT(243)
483 tagOf_PrimOp ParGlobalOp = ILIT(244)
484 tagOf_PrimOp ParLocalOp = ILIT(245)
485 tagOf_PrimOp ParAtOp = ILIT(246)
486 tagOf_PrimOp ParAtAbsOp = ILIT(247)
487 tagOf_PrimOp ParAtRelOp = ILIT(248)
488 tagOf_PrimOp ParAtForNowOp = ILIT(249)
489 tagOf_PrimOp CopyableOp = ILIT(250)
490 tagOf_PrimOp NoFollowOp = ILIT(251)
491 tagOf_PrimOp NewMutVarOp = ILIT(252)
492 tagOf_PrimOp ReadMutVarOp = ILIT(253)
493 tagOf_PrimOp WriteMutVarOp = ILIT(254)
494 tagOf_PrimOp SameMutVarOp = ILIT(255)
495 tagOf_PrimOp CatchOp = ILIT(256)
496 tagOf_PrimOp RaiseOp = ILIT(257)
497 tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(258)
498 tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(259)
499 tagOf_PrimOp DataToTagOp = ILIT(260)
500 tagOf_PrimOp TagToEnumOp = ILIT(261)
502 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
504 instance Eq PrimOp where
505 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
507 instance Ord PrimOp where
508 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
509 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
510 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
511 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
512 op1 `compare` op2 | op1 < op2 = LT
516 instance Outputable PrimOp where
517 ppr op = pprPrimOp op
519 instance Show PrimOp where
520 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
523 An @Enum@-derived list would be better; meanwhile... (ToDo)
525 allThePrimOps -- Except CCall, which is really a family of primops
657 NewByteArrayOp CharRep,
658 NewByteArrayOp IntRep,
659 NewByteArrayOp WordRep,
660 NewByteArrayOp AddrRep,
661 NewByteArrayOp FloatRep,
662 NewByteArrayOp DoubleRep,
663 NewByteArrayOp StablePtrRep,
665 SameMutableByteArrayOp,
669 ReadByteArrayOp CharRep,
670 ReadByteArrayOp IntRep,
671 ReadByteArrayOp WordRep,
672 ReadByteArrayOp AddrRep,
673 ReadByteArrayOp FloatRep,
674 ReadByteArrayOp DoubleRep,
675 ReadByteArrayOp StablePtrRep,
676 ReadByteArrayOp Int64Rep,
677 ReadByteArrayOp Word64Rep,
678 WriteByteArrayOp CharRep,
679 WriteByteArrayOp IntRep,
680 WriteByteArrayOp WordRep,
681 WriteByteArrayOp AddrRep,
682 WriteByteArrayOp FloatRep,
683 WriteByteArrayOp DoubleRep,
684 WriteByteArrayOp StablePtrRep,
685 WriteByteArrayOp Int64Rep,
686 WriteByteArrayOp Word64Rep,
687 IndexByteArrayOp CharRep,
688 IndexByteArrayOp IntRep,
689 IndexByteArrayOp WordRep,
690 IndexByteArrayOp AddrRep,
691 IndexByteArrayOp FloatRep,
692 IndexByteArrayOp DoubleRep,
693 IndexByteArrayOp StablePtrRep,
694 IndexByteArrayOp Int64Rep,
695 IndexByteArrayOp Word64Rep,
696 IndexOffForeignObjOp CharRep,
697 IndexOffForeignObjOp AddrRep,
698 IndexOffForeignObjOp IntRep,
699 IndexOffForeignObjOp WordRep,
700 IndexOffForeignObjOp FloatRep,
701 IndexOffForeignObjOp DoubleRep,
702 IndexOffForeignObjOp StablePtrRep,
703 IndexOffForeignObjOp Int64Rep,
704 IndexOffForeignObjOp Word64Rep,
705 IndexOffAddrOp CharRep,
706 IndexOffAddrOp IntRep,
707 IndexOffAddrOp WordRep,
708 IndexOffAddrOp AddrRep,
709 IndexOffAddrOp FloatRep,
710 IndexOffAddrOp DoubleRep,
711 IndexOffAddrOp StablePtrRep,
712 IndexOffAddrOp Int64Rep,
713 IndexOffAddrOp Word64Rep,
714 ReadOffAddrOp CharRep,
715 ReadOffAddrOp IntRep,
716 ReadOffAddrOp WordRep,
717 ReadOffAddrOp AddrRep,
718 ReadOffAddrOp FloatRep,
719 ReadOffAddrOp DoubleRep,
720 ReadOffAddrOp ForeignObjRep,
721 ReadOffAddrOp StablePtrRep,
722 ReadOffAddrOp Int64Rep,
723 ReadOffAddrOp Word64Rep,
724 WriteOffAddrOp CharRep,
725 WriteOffAddrOp IntRep,
726 WriteOffAddrOp WordRep,
727 WriteOffAddrOp AddrRep,
728 WriteOffAddrOp FloatRep,
729 WriteOffAddrOp DoubleRep,
730 WriteOffAddrOp ForeignObjRep,
731 WriteOffAddrOp StablePtrRep,
732 WriteOffAddrOp Int64Rep,
733 WriteOffAddrOp Word64Rep,
735 UnsafeFreezeByteArrayOp,
738 SizeofMutableByteArrayOp,
745 BlockAsyncExceptionsOp,
746 UnblockAsyncExceptionsOp,
763 ReallyUnsafePtrEqualityOp,
786 %************************************************************************
788 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
790 %************************************************************************
792 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
793 refer to the primitive operation. The conventional \tr{#}-for-
794 unboxed ops is added on later.
796 The reason for the funny characters in the names is so we do not
797 interfere with the programmer's Haskell name spaces.
799 We use @PrimKinds@ for the ``type'' information, because they're
800 (slightly) more convenient to use than @TyCons@.
803 = Dyadic OccName -- string :: T -> T -> T
805 | Monadic OccName -- string :: T -> T
807 | Compare OccName -- string :: T -> T -> Bool
810 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
815 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
816 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
817 mkCompare str ty = Compare (mkSrcVarOcc str) ty
818 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
823 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
825 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
826 intPrimTy, byteArrayPrimTy] -- second '' pieces
827 an_Integer_and_Int_tys
828 = [intPrimTy, byteArrayPrimTy, -- Integer
831 unboxedPair = mkUnboxedTupleTy 2
832 unboxedTriple = mkUnboxedTupleTy 3
833 unboxedQuadruple = mkUnboxedTupleTy 4
835 mkIOTy ty = mkFunTy realWorldStatePrimTy
836 (unboxedPair [realWorldStatePrimTy,ty])
838 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
839 (unboxedPair one_Integer_ty)
841 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
842 (unboxedPair one_Integer_ty)
844 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
845 (unboxedQuadruple two_Integer_tys)
847 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
850 %************************************************************************
852 \subsubsection{Strictness}
854 %************************************************************************
856 Not all primops are strict!
859 primOpStrictness :: Arity -> PrimOp -> StrictnessInfo
860 -- See Demand.StrictnessInfo for discussion of what the results
861 -- The arity should be the arity of the primop; that's why
862 -- this function isn't exported.
864 primOpStrictness arity SeqOp = StrictnessInfo [wwStrict] False
865 -- Seq is strict in its argument; see notes in ConFold.lhs
867 primOpStrictness arity ParOp = StrictnessInfo [wwLazy] False
868 -- Note that Par is lazy to avoid that the sparked thing
869 -- gets evaluted strictly, which it should *not* be
871 primOpStrictness arity ForkOp = StrictnessInfo [wwLazy, wwPrim] False
873 primOpStrictness arity NewArrayOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
874 primOpStrictness arity WriteArrayOp = StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False
876 primOpStrictness arity NewMutVarOp = StrictnessInfo [wwLazy, wwPrim] False
877 primOpStrictness arity WriteMutVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
879 primOpStrictness arity PutMVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
881 primOpStrictness arity CatchOp = StrictnessInfo [wwLazy, wwLazy, wwPrim] False
882 -- Catch is actually strict in its first argument
883 -- but we don't want to tell the strictness
884 -- analyser about that!
886 primOpStrictness arity RaiseOp = StrictnessInfo [wwLazy] True -- NB: True => result is bottom
887 primOpStrictness arity BlockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
888 primOpStrictness arity UnblockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
890 primOpStrictness arity MkWeakOp = StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False
891 primOpStrictness arity MakeStableNameOp = StrictnessInfo [wwLazy, wwPrim] False
892 primOpStrictness arity MakeStablePtrOp = StrictnessInfo [wwLazy, wwPrim] False
894 primOpStrictness arity DataToTagOp = StrictnessInfo [wwLazy] False
896 -- The rest all have primitive-typed arguments
897 primOpStrictness arity other = StrictnessInfo (replicate arity wwPrim) False
900 %************************************************************************
902 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
904 %************************************************************************
906 @primOpInfo@ gives all essential information (from which everything
907 else, notably a type, can be constructed) for each @PrimOp@.
910 primOpInfo :: PrimOp -> PrimOpInfo
913 There's plenty of this stuff!
916 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
917 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
918 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
919 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
920 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
921 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
923 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
924 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
925 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
926 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
927 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
928 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
930 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
931 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
932 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
933 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
934 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
935 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
937 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
938 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
939 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
940 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
941 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
942 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
944 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
945 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
946 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
947 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
948 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
949 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
951 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
952 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
953 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
954 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
955 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
956 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
960 %************************************************************************
962 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
964 %************************************************************************
967 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
968 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
971 %************************************************************************
973 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
975 %************************************************************************
978 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
979 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
980 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
981 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
982 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
983 primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
985 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
987 primOpInfo IntAddCOp =
988 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
989 (unboxedPair [intPrimTy, intPrimTy])
991 primOpInfo IntSubCOp =
992 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
993 (unboxedPair [intPrimTy, intPrimTy])
995 primOpInfo IntMulCOp =
996 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
997 (unboxedPair [intPrimTy, intPrimTy])
1000 %************************************************************************
1002 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1004 %************************************************************************
1006 A @Word#@ is an unsigned @Int#@.
1009 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1010 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1012 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1013 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1014 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1015 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1018 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1020 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1023 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1025 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1027 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1029 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1030 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1033 %************************************************************************
1035 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1037 %************************************************************************
1040 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1041 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1045 %************************************************************************
1047 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1049 %************************************************************************
1051 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1054 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1055 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1056 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1057 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1058 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1060 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1061 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1063 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1064 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1065 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1066 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1067 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1068 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1069 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1070 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1071 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1072 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1073 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1074 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1075 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1078 %************************************************************************
1080 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1082 %************************************************************************
1084 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1087 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1088 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1089 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1090 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1091 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1093 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1094 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1096 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1097 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1099 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1100 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1101 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1102 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1103 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1104 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1105 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1106 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1107 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1108 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1109 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1110 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1111 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1114 %************************************************************************
1116 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1118 %************************************************************************
1121 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1123 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1124 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1125 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1126 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1127 primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1128 primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
1129 primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
1130 primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
1132 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1133 primOpInfo IntegerCmpIntOp
1134 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1136 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1137 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1139 primOpInfo Integer2IntOp
1140 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1142 primOpInfo Integer2WordOp
1143 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1145 primOpInfo Int2IntegerOp
1146 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1147 (unboxedPair one_Integer_ty)
1149 primOpInfo Word2IntegerOp
1150 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1151 (unboxedPair one_Integer_ty)
1153 primOpInfo Addr2IntegerOp
1154 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1155 (unboxedPair one_Integer_ty)
1157 primOpInfo IntegerToInt64Op
1158 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1160 primOpInfo Int64ToIntegerOp
1161 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1162 (unboxedPair one_Integer_ty)
1164 primOpInfo Word64ToIntegerOp
1165 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1166 (unboxedPair one_Integer_ty)
1168 primOpInfo IntegerToWord64Op
1169 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1172 Decoding of floating-point numbers is sorta Integer-related. Encoding
1173 is done with plain ccalls now (see PrelNumExtra.lhs).
1176 primOpInfo FloatDecodeOp
1177 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1178 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1179 primOpInfo DoubleDecodeOp
1180 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1181 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1184 %************************************************************************
1186 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1188 %************************************************************************
1191 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1192 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1196 primOpInfo NewArrayOp
1198 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1199 state = mkStatePrimTy s
1201 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1202 [intPrimTy, elt, state]
1203 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1205 primOpInfo (NewByteArrayOp kind)
1207 s = alphaTy; s_tv = alphaTyVar
1209 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1210 state = mkStatePrimTy s
1212 mkGenPrimOp op_str [s_tv]
1214 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1216 ---------------------------------------------------------------------------
1219 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1220 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1223 primOpInfo SameMutableArrayOp
1225 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1226 mut_arr_ty = mkMutableArrayPrimTy s elt
1228 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1231 primOpInfo SameMutableByteArrayOp
1233 s = alphaTy; s_tv = alphaTyVar;
1234 mut_arr_ty = mkMutableByteArrayPrimTy s
1236 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1239 ---------------------------------------------------------------------------
1240 -- Primitive arrays of Haskell pointers:
1243 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1244 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1245 indexArray# :: Array# a -> Int# -> (# a #)
1248 primOpInfo ReadArrayOp
1250 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1251 state = mkStatePrimTy s
1253 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1254 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1255 (unboxedPair [state, elt])
1258 primOpInfo WriteArrayOp
1260 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1262 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1263 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1266 primOpInfo IndexArrayOp
1267 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1268 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1269 (mkUnboxedTupleTy 1 [elt])
1271 ---------------------------------------------------------------------------
1272 -- Primitive arrays full of unboxed bytes:
1274 primOpInfo (ReadByteArrayOp kind)
1276 s = alphaTy; s_tv = alphaTyVar
1278 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1279 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1280 state = mkStatePrimTy s
1282 mkGenPrimOp op_str (s_tv:tvs)
1283 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1284 (unboxedPair [state, prim_ty])
1286 primOpInfo (WriteByteArrayOp kind)
1288 s = alphaTy; s_tv = alphaTyVar
1289 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1290 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1292 mkGenPrimOp op_str (s_tv:tvs)
1293 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1296 primOpInfo (IndexByteArrayOp kind)
1298 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1299 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1301 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1303 primOpInfo (IndexOffForeignObjOp kind)
1305 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1306 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1308 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1310 primOpInfo (IndexOffAddrOp kind)
1312 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1313 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1315 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1317 primOpInfo (ReadOffAddrOp kind)
1319 s = alphaTy; s_tv = alphaTyVar
1320 op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#")
1321 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1322 state = mkStatePrimTy s
1324 mkGenPrimOp op_str (s_tv:tvs)
1325 [addrPrimTy, intPrimTy, state]
1326 (unboxedPair [state, prim_ty])
1328 primOpInfo (WriteOffAddrOp kind)
1330 s = alphaTy; s_tv = alphaTyVar
1331 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1332 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1334 mkGenPrimOp op_str (s_tv:tvs)
1335 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1338 ---------------------------------------------------------------------------
1340 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1341 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1342 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1345 primOpInfo UnsafeFreezeArrayOp
1347 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1348 state = mkStatePrimTy s
1350 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1351 [mkMutableArrayPrimTy s elt, state]
1352 (unboxedPair [state, mkArrayPrimTy elt])
1354 primOpInfo UnsafeFreezeByteArrayOp
1356 s = alphaTy; s_tv = alphaTyVar;
1357 state = mkStatePrimTy s
1359 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1360 [mkMutableByteArrayPrimTy s, state]
1361 (unboxedPair [state, byteArrayPrimTy])
1363 primOpInfo UnsafeThawArrayOp
1365 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1366 state = mkStatePrimTy s
1368 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
1369 [mkArrayPrimTy elt, state]
1370 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1372 ---------------------------------------------------------------------------
1373 primOpInfo SizeofByteArrayOp
1375 SLIT("sizeofByteArray#") []
1379 primOpInfo SizeofMutableByteArrayOp
1380 = let { s = alphaTy; s_tv = alphaTyVar } in
1382 SLIT("sizeofMutableByteArray#") [s_tv]
1383 [mkMutableByteArrayPrimTy s]
1388 %************************************************************************
1390 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1392 %************************************************************************
1395 primOpInfo NewMutVarOp
1397 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1398 state = mkStatePrimTy s
1400 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1402 (unboxedPair [state, mkMutVarPrimTy s elt])
1404 primOpInfo ReadMutVarOp
1406 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1407 state = mkStatePrimTy s
1409 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1410 [mkMutVarPrimTy s elt, state]
1411 (unboxedPair [state, elt])
1414 primOpInfo WriteMutVarOp
1416 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1418 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1419 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1422 primOpInfo SameMutVarOp
1424 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1425 mut_var_ty = mkMutVarPrimTy s elt
1427 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1431 %************************************************************************
1433 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1435 %************************************************************************
1437 catch# :: (State# RealWorld -> (# State# RealWorld, a))
1438 -> (b -> State# RealWorld -> (# State# RealWorld, a))
1440 -> (# State# RealWorld, a)
1442 throw :: Exception -> a
1445 blockAsyncExceptions# :: IO a -> IO a
1446 unblockAsyncExceptions# :: IO a -> IO a
1451 a = alphaTy; a_tv = alphaTyVar
1452 b = betaTy; b_tv = betaTyVar;
1455 mkGenPrimOp SLIT("catch#") [a_tv, b_tv]
1456 [io_a, mkFunTy b io_a, realWorldStatePrimTy]
1457 (unboxedPair [realWorldStatePrimTy, a])
1461 a = alphaTy; a_tv = alphaTyVar
1462 b = betaTy; b_tv = betaTyVar;
1464 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1466 primOpInfo BlockAsyncExceptionsOp
1468 a = alphaTy; a_tv = alphaTyVar
1470 mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
1471 [ mkIOTy a, realWorldStatePrimTy ]
1472 (unboxedPair [realWorldStatePrimTy,a])
1474 primOpInfo UnblockAsyncExceptionsOp
1476 a = alphaTy; a_tv = alphaTyVar
1478 mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
1479 [ mkIOTy a, realWorldStatePrimTy ]
1480 (unboxedPair [realWorldStatePrimTy,a])
1483 %************************************************************************
1485 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1487 %************************************************************************
1490 primOpInfo NewMVarOp
1492 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1493 state = mkStatePrimTy s
1495 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1496 (unboxedPair [state, mkMVarPrimTy s elt])
1498 primOpInfo TakeMVarOp
1500 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1501 state = mkStatePrimTy s
1503 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1504 [mkMVarPrimTy s elt, state]
1505 (unboxedPair [state, elt])
1507 primOpInfo PutMVarOp
1509 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1511 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1512 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1515 primOpInfo SameMVarOp
1517 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1518 mvar_ty = mkMVarPrimTy s elt
1520 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1522 primOpInfo IsEmptyMVarOp
1524 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1525 state = mkStatePrimTy s
1527 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1528 [mkMVarPrimTy s elt, mkStatePrimTy s]
1529 (unboxedPair [state, intPrimTy])
1533 %************************************************************************
1535 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1537 %************************************************************************
1543 s = alphaTy; s_tv = alphaTyVar
1545 mkGenPrimOp SLIT("delay#") [s_tv]
1546 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1548 primOpInfo WaitReadOp
1550 s = alphaTy; s_tv = alphaTyVar
1552 mkGenPrimOp SLIT("waitRead#") [s_tv]
1553 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1555 primOpInfo WaitWriteOp
1557 s = alphaTy; s_tv = alphaTyVar
1559 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1560 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1563 %************************************************************************
1565 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1567 %************************************************************************
1570 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1572 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1573 [alphaTy, realWorldStatePrimTy]
1574 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1576 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1577 primOpInfo KillThreadOp
1578 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1579 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1580 realWorldStatePrimTy
1582 -- yield# :: State# RealWorld -> State# RealWorld
1584 = mkGenPrimOp SLIT("yield#") []
1585 [realWorldStatePrimTy]
1586 realWorldStatePrimTy
1588 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1589 primOpInfo MyThreadIdOp
1590 = mkGenPrimOp SLIT("myThreadId#") []
1591 [realWorldStatePrimTy]
1592 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1595 ************************************************************************
1597 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1599 %************************************************************************
1602 primOpInfo MakeForeignObjOp
1603 = mkGenPrimOp SLIT("makeForeignObj#") []
1604 [addrPrimTy, realWorldStatePrimTy]
1605 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1607 primOpInfo WriteForeignObjOp
1609 s = alphaTy; s_tv = alphaTyVar
1611 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1612 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1615 ************************************************************************
1617 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1619 %************************************************************************
1621 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1623 mkWeak# :: k -> v -> f -> State# RealWorld
1624 -> (# State# RealWorld, Weak# v #)
1626 In practice, you'll use the higher-level
1628 data Weak v = Weak# v
1629 mkWeak :: k -> v -> IO () -> IO (Weak v)
1633 = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
1634 [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
1635 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1638 The following operation dereferences a weak pointer. The weak pointer
1639 may have been finalized, so the operation returns a result code which
1640 must be inspected before looking at the dereferenced value.
1642 deRefWeak# :: Weak# v -> State# RealWorld ->
1643 (# State# RealWorld, v, Int# #)
1645 Only look at v if the Int# returned is /= 0 !!
1647 The higher-level op is
1649 deRefWeak :: Weak v -> IO (Maybe v)
1652 primOpInfo DeRefWeakOp
1653 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1654 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1655 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1658 Weak pointers can be finalized early by using the finalize# operation:
1660 finalizeWeak# :: Weak# v -> State# RealWorld ->
1661 (# State# RealWorld, Int#, IO () #)
1663 The Int# returned is either
1665 0 if the weak pointer has already been finalized, or it has no
1666 finalizer (the third component is then invalid).
1668 1 if the weak pointer is still alive, with the finalizer returned
1669 as the third component.
1672 primOpInfo FinalizeWeakOp
1673 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1674 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1675 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1676 mkFunTy realWorldStatePrimTy
1677 (unboxedPair [realWorldStatePrimTy,unitTy])])
1680 %************************************************************************
1682 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1684 %************************************************************************
1686 A {\em stable name/pointer} is an index into a table of stable name
1687 entries. Since the garbage collector is told about stable pointers,
1688 it is safe to pass a stable pointer to external systems such as C
1692 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1693 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1694 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1695 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1698 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1699 operation since it doesn't (directly) involve IO operations. The
1700 reason is that if some optimisation pass decided to duplicate calls to
1701 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1702 massive space leak can result. Putting it into the IO monad
1703 prevents this. (Another reason for putting them in a monad is to
1704 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1707 An important property of stable pointers is that if you call
1708 makeStablePtr# twice on the same object you get the same stable
1711 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1712 besides, it's not likely to be used from Haskell) so it's not a
1715 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1720 A stable name is like a stable pointer, but with three important differences:
1722 (a) You can't deRef one to get back to the original object.
1723 (b) You can convert one to an Int.
1724 (c) You don't need to 'freeStableName'
1726 The existence of a stable name doesn't guarantee to keep the object it
1727 points to alive (unlike a stable pointer), hence (a).
1731 (a) makeStableName always returns the same value for a given
1732 object (same as stable pointers).
1734 (b) if two stable names are equal, it implies that the objects
1735 from which they were created were the same.
1737 (c) stableNameToInt always returns the same Int for a given
1741 primOpInfo MakeStablePtrOp
1742 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1743 [alphaTy, realWorldStatePrimTy]
1744 (unboxedPair [realWorldStatePrimTy,
1745 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1747 primOpInfo DeRefStablePtrOp
1748 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1749 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1750 (unboxedPair [realWorldStatePrimTy, alphaTy])
1752 primOpInfo EqStablePtrOp
1753 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1754 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1757 primOpInfo MakeStableNameOp
1758 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1759 [alphaTy, realWorldStatePrimTy]
1760 (unboxedPair [realWorldStatePrimTy,
1761 mkTyConApp stableNamePrimTyCon [alphaTy]])
1763 primOpInfo EqStableNameOp
1764 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1765 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1768 primOpInfo StableNameToIntOp
1769 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1770 [mkStableNamePrimTy alphaTy]
1774 %************************************************************************
1776 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1778 %************************************************************************
1780 [Alastair Reid is to blame for this!]
1782 These days, (Glasgow) Haskell seems to have a bit of everything from
1783 other languages: strict operations, mutable variables, sequencing,
1784 pointers, etc. About the only thing left is LISP's ability to test
1785 for pointer equality. So, let's add it in!
1788 reallyUnsafePtrEquality :: a -> a -> Int#
1791 which tests any two closures (of the same type) to see if they're the
1792 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1793 difficulties of trying to box up the result.)
1795 NB This is {\em really unsafe\/} because even something as trivial as
1796 a garbage collection might change the answer by removing indirections.
1797 Still, no-one's forcing you to use it. If you're worried about little
1798 things like loss of referential transparency, you might like to wrap
1799 it all up in a monad-like thing as John O'Donnell and John Hughes did
1800 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1803 I'm thinking of using it to speed up a critical equality test in some
1804 graphics stuff in a context where the possibility of saying that
1805 denotationally equal things aren't isn't a problem (as long as it
1806 doesn't happen too often.) ADR
1808 To Will: Jim said this was already in, but I can't see it so I'm
1809 adding it. Up to you whether you add it. (Note that this could have
1810 been readily implemented using a @veryDangerousCCall@ before they were
1814 primOpInfo ReallyUnsafePtrEqualityOp
1815 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1816 [alphaTy, alphaTy] intPrimTy
1819 %************************************************************************
1821 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1823 %************************************************************************
1826 primOpInfo SeqOp -- seq# :: a -> Int#
1827 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1829 primOpInfo ParOp -- par# :: a -> Int#
1830 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1834 -- HWL: The first 4 Int# in all par... annotations denote:
1835 -- name, granularity info, size of result, degree of parallelism
1836 -- Same structure as _seq_ i.e. returns Int#
1837 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1838 -- `the processor containing the expression v'; it is not evaluated
1840 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1841 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1843 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1844 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1846 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1847 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1849 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1850 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1852 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1853 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1855 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1856 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1858 primOpInfo CopyableOp -- copyable# :: a -> Int#
1859 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1861 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1862 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1865 %************************************************************************
1867 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1869 %************************************************************************
1871 These primops are pretty wierd.
1873 dataToTag# :: a -> Int (arg must be an evaluated data type)
1874 tagToEnum# :: Int -> a (result type must be an enumerated type)
1876 The constraints aren't currently checked by the front end, but the
1877 code generator will fall over if they aren't satisfied.
1880 primOpInfo DataToTagOp
1881 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1883 primOpInfo TagToEnumOp
1884 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1887 primOpInfo op = pprPanic "primOpInfo:" (ppr op)
1891 %************************************************************************
1893 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1895 %************************************************************************
1897 Some PrimOps need to be called out-of-line because they either need to
1898 perform a heap check or they block.
1910 BlockAsyncExceptionsOp -> True
1911 UnblockAsyncExceptionsOp -> True
1913 NewByteArrayOp _ -> True
1914 IntegerAddOp -> True
1915 IntegerSubOp -> True
1916 IntegerMulOp -> True
1917 IntegerGcdOp -> True
1918 IntegerDivExactOp -> True
1919 IntegerQuotOp -> True
1920 IntegerRemOp -> True
1921 IntegerQuotRemOp -> True
1922 IntegerDivModOp -> True
1923 Int2IntegerOp -> True
1924 Word2IntegerOp -> True
1925 Addr2IntegerOp -> True
1926 Word64ToIntegerOp -> True
1927 Int64ToIntegerOp -> True
1928 FloatDecodeOp -> True
1929 DoubleDecodeOp -> True
1931 FinalizeWeakOp -> True
1932 MakeStableNameOp -> True
1933 MakeForeignObjOp -> True
1937 KillThreadOp -> True
1940 UnsafeThawArrayOp -> True
1941 -- UnsafeThawArrayOp doesn't perform any heap checks,
1942 -- but it is of such an esoteric nature that
1943 -- it is done out-of-line rather than require
1944 -- the NCG to implement it.
1946 CCallOp ccall -> ccallMayGC ccall
1952 primOpOkForSpeculation
1953 ~~~~~~~~~~~~~~~~~~~~~~
1954 Sometimes we may choose to execute a PrimOp even though it isn't
1955 certain that its result will be required; ie execute them
1956 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1957 this is OK, because PrimOps are usually cheap, but it isn't OK for
1958 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1960 PrimOps that have side effects also should not be executed speculatively.
1962 Ok-for-speculation also means that it's ok *not* to execute the
1966 Here the result is not used, so we can discard the primop. Anything
1967 that has side effects mustn't be dicarded in this way, of course!
1969 See also @primOpIsCheap@ (below).
1973 primOpOkForSpeculation :: PrimOp -> Bool
1974 -- See comments with CoreUtils.exprOkForSpeculation
1975 primOpOkForSpeculation op
1976 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1982 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1983 WARNING), we just borrow some other predicates for a
1984 what-should-be-good-enough test. "Cheap" means willing to call it more
1985 than once. Evaluation order is unaffected.
1988 primOpIsCheap :: PrimOp -> Bool
1989 -- See comments with CoreUtils.exprOkForSpeculation
1990 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
1995 primOpIsDupable means that the use of the primop is small enough to
1996 duplicate into different case branches. See CoreUtils.exprIsDupable.
1999 primOpIsDupable :: PrimOp -> Bool
2000 -- See comments with CoreUtils.exprIsDupable
2001 -- We say it's dupable it isn't implemented by a C call with a wrapper
2002 primOpIsDupable op = not (primOpNeedsWrapper op)
2007 primOpCanFail :: PrimOp -> Bool
2009 primOpCanFail IntQuotOp = True -- Divide by zero
2010 primOpCanFail IntRemOp = True -- Divide by zero
2013 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2014 primOpCanFail IntegerDivModOp = True -- Divide by zero
2016 -- Float. ToDo: tan? tanh?
2017 primOpCanFail FloatDivOp = True -- Divide by zero
2018 primOpCanFail FloatLogOp = True -- Log of zero
2019 primOpCanFail FloatAsinOp = True -- Arg out of domain
2020 primOpCanFail FloatAcosOp = True -- Arg out of domain
2022 -- Double. ToDo: tan? tanh?
2023 primOpCanFail DoubleDivOp = True -- Divide by zero
2024 primOpCanFail DoubleLogOp = True -- Log of zero
2025 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2026 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2028 primOpCanFail other_op = False
2031 And some primops have side-effects and so, for example, must not be
2035 primOpHasSideEffects :: PrimOp -> Bool
2037 primOpHasSideEffects ParOp = True
2038 primOpHasSideEffects ForkOp = True
2039 primOpHasSideEffects KillThreadOp = True
2040 primOpHasSideEffects YieldOp = True
2041 primOpHasSideEffects SeqOp = True
2043 primOpHasSideEffects MakeForeignObjOp = True
2044 primOpHasSideEffects WriteForeignObjOp = True
2045 primOpHasSideEffects MkWeakOp = True
2046 primOpHasSideEffects DeRefWeakOp = True
2047 primOpHasSideEffects FinalizeWeakOp = True
2048 primOpHasSideEffects MakeStablePtrOp = True
2049 primOpHasSideEffects MakeStableNameOp = True
2050 primOpHasSideEffects EqStablePtrOp = True -- SOF
2051 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2053 -- In general, writes are considered a side effect, but
2054 -- reads and variable allocations are not
2055 -- Why? Because writes must not be omitted, but reads can be if their result is not used.
2056 -- (Sequencing of reads is maintained by data dependencies on the resulting
2058 primOpHasSideEffects WriteArrayOp = True
2059 primOpHasSideEffects (WriteByteArrayOp _) = True
2060 primOpHasSideEffects (WriteOffAddrOp _) = True
2061 primOpHasSideEffects WriteMutVarOp = True
2063 primOpHasSideEffects UnsafeFreezeArrayOp = True
2064 primOpHasSideEffects UnsafeFreezeByteArrayOp = True
2065 primOpHasSideEffects UnsafeThawArrayOp = True
2067 primOpHasSideEffects TakeMVarOp = True
2068 primOpHasSideEffects PutMVarOp = True
2069 primOpHasSideEffects DelayOp = True
2070 primOpHasSideEffects WaitReadOp = True
2071 primOpHasSideEffects WaitWriteOp = True
2073 primOpHasSideEffects ParGlobalOp = True
2074 primOpHasSideEffects ParLocalOp = True
2075 primOpHasSideEffects ParAtOp = True
2076 primOpHasSideEffects ParAtAbsOp = True
2077 primOpHasSideEffects ParAtRelOp = True
2078 primOpHasSideEffects ParAtForNowOp = True
2079 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2080 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2081 primOpHasSideEffects (CCallOp _) = True
2083 primOpHasSideEffects other = False
2086 Inline primitive operations that perform calls need wrappers to save
2087 any live variables that are stored in caller-saves registers.
2090 primOpNeedsWrapper :: PrimOp -> Bool
2092 primOpNeedsWrapper (CCallOp _) = True
2094 primOpNeedsWrapper Integer2IntOp = True
2095 primOpNeedsWrapper Integer2WordOp = True
2096 primOpNeedsWrapper IntegerCmpOp = True
2097 primOpNeedsWrapper IntegerCmpIntOp = True
2099 primOpNeedsWrapper FloatExpOp = True
2100 primOpNeedsWrapper FloatLogOp = True
2101 primOpNeedsWrapper FloatSqrtOp = True
2102 primOpNeedsWrapper FloatSinOp = True
2103 primOpNeedsWrapper FloatCosOp = True
2104 primOpNeedsWrapper FloatTanOp = True
2105 primOpNeedsWrapper FloatAsinOp = True
2106 primOpNeedsWrapper FloatAcosOp = True
2107 primOpNeedsWrapper FloatAtanOp = True
2108 primOpNeedsWrapper FloatSinhOp = True
2109 primOpNeedsWrapper FloatCoshOp = True
2110 primOpNeedsWrapper FloatTanhOp = True
2111 primOpNeedsWrapper FloatPowerOp = True
2113 primOpNeedsWrapper DoubleExpOp = True
2114 primOpNeedsWrapper DoubleLogOp = True
2115 primOpNeedsWrapper DoubleSqrtOp = True
2116 primOpNeedsWrapper DoubleSinOp = True
2117 primOpNeedsWrapper DoubleCosOp = True
2118 primOpNeedsWrapper DoubleTanOp = True
2119 primOpNeedsWrapper DoubleAsinOp = True
2120 primOpNeedsWrapper DoubleAcosOp = True
2121 primOpNeedsWrapper DoubleAtanOp = True
2122 primOpNeedsWrapper DoubleSinhOp = True
2123 primOpNeedsWrapper DoubleCoshOp = True
2124 primOpNeedsWrapper DoubleTanhOp = True
2125 primOpNeedsWrapper DoublePowerOp = True
2127 primOpNeedsWrapper MakeStableNameOp = True
2128 primOpNeedsWrapper DeRefStablePtrOp = True
2130 primOpNeedsWrapper DelayOp = True
2131 primOpNeedsWrapper WaitReadOp = True
2132 primOpNeedsWrapper WaitWriteOp = True
2134 primOpNeedsWrapper other_op = False
2138 primOpArity :: PrimOp -> Arity
2140 = case (primOpInfo op) of
2144 GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
2146 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2148 = case (primOpInfo op) of
2149 Dyadic occ ty -> dyadic_fun_ty ty
2150 Monadic occ ty -> monadic_fun_ty ty
2151 Compare occ ty -> compare_fun_ty ty
2153 GenPrimOp occ tyvars arg_tys res_ty ->
2154 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2156 mkPrimOpIdName :: PrimOp -> Id -> Name
2157 -- Make the name for the PrimOp's Id
2158 -- We have to pass in the Id itself because it's a WiredInId
2159 -- and hence recursive
2160 mkPrimOpIdName op id
2161 = mkWiredInIdName key pREL_GHC occ_name id
2163 occ_name = primOpOcc op
2164 key = mkPrimOpIdUnique (primOpTag op)
2167 primOpRdrName :: PrimOp -> RdrName
2168 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2170 primOpOcc :: PrimOp -> OccName
2171 primOpOcc op = case (primOpInfo op) of
2173 Monadic occ _ -> occ
2174 Compare occ _ -> occ
2175 GenPrimOp occ _ _ _ -> occ
2177 -- primOpSig is like primOpType but gives the result split apart:
2178 -- (type variables, argument types, result type)
2179 -- It also gives arity, strictness info
2181 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
2183 = (tyvars, arg_tys, res_ty, arity, primOpStrictness arity op)
2185 arity = length arg_tys
2186 (tyvars, arg_tys, res_ty)
2187 = case (primOpInfo op) of
2188 Monadic occ ty -> ([], [ty], ty )
2189 Dyadic occ ty -> ([], [ty,ty], ty )
2190 Compare occ ty -> ([], [ty,ty], boolTy)
2191 GenPrimOp occ tyvars arg_tys res_ty
2192 -> (tyvars, arg_tys, res_ty)
2194 -- primOpUsg is like primOpSig but the types it yields are the
2195 -- appropriate sigma (i.e., usage-annotated) types,
2196 -- as required by the UsageSP inference.
2198 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2202 -- Refer to comment by `otherwise' clause; we need consider here
2203 -- *only* primops that have arguments or results containing Haskell
2204 -- pointers (things that are pointed). Unpointed values are
2205 -- irrelevant to the usage analysis. The issue is whether pointed
2206 -- values may be entered or duplicated by the primop.
2208 -- Remember that primops are *never* partially applied.
2210 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2211 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2212 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2213 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2214 IndexArrayOp -> mangle [mkM, mkP ] mkM
2215 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2216 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2218 NewMutVarOp -> mangle [mkM, mkP ] mkM
2219 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2220 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2221 SameMutVarOp -> mangle [mkP, mkP ] mkM
2223 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2224 mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM
2225 -- might use caught action multiply
2226 RaiseOp -> mangle [mkM ] mkM
2228 NewMVarOp -> mangle [mkP ] mkR
2229 TakeMVarOp -> mangle [mkM, mkP ] mkM
2230 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2231 SameMVarOp -> mangle [mkP, mkP ] mkM
2232 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2234 ForkOp -> mangle [mkO, mkP ] mkR
2235 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2237 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2238 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2239 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2241 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2242 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2243 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2244 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2245 EqStableNameOp -> mangle [mkP, mkP ] mkR
2246 StableNameToIntOp -> mangle [mkP ] mkR
2248 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2250 SeqOp -> mangle [mkO ] mkR
2251 ParOp -> mangle [mkO ] mkR
2252 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2253 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2254 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2255 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2256 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2257 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2258 CopyableOp -> mangle [mkZ ] mkR
2259 NoFollowOp -> mangle [mkZ ] mkR
2261 CCallOp _ -> mangle [ ] mkM
2263 -- Things with no Haskell pointers inside: in actuality, usages are
2264 -- irrelevant here (hence it doesn't matter that some of these
2265 -- apparently permit duplication; since such arguments are never
2266 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2267 -- except insofar as it propagates to infect other values that *are*
2270 otherwise -> nomangle
2272 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2273 mkO = mkUsgTy UsOnce -- pointed argument used once
2274 mkM = mkUsgTy UsMany -- pointed argument used multiply
2275 mkP = mkUsgTy UsOnce -- unpointed argument
2276 mkR = mkUsgTy UsMany -- unpointed result
2278 (tyvars, arg_tys, res_ty, _, _) = primOpSig op
2280 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2282 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2284 inFun f g ty = case splitFunTy_maybe ty of
2285 Just (a,b) -> mkFunTy (f a) (g b)
2286 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2288 inUB fs ty = case splitTyConApp_maybe ty of
2289 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
2290 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
2292 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2296 data PrimOpResultInfo
2297 = ReturnsPrim PrimRep
2300 -- Some PrimOps need not return a manifest primitive or algebraic value
2301 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2302 -- be out of line, or the code generator won't work.
2304 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2305 getPrimOpResultInfo (CCallOp _)
2306 = ReturnsAlg unboxedPairTyCon
2307 getPrimOpResultInfo op
2308 = case (primOpInfo op) of
2309 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2310 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2311 Compare _ ty -> ReturnsAlg boolTyCon
2312 GenPrimOp _ _ _ ty ->
2313 let rep = typePrimRep ty in
2315 PtrRep -> case splitAlgTyConApp_maybe ty of
2316 Nothing -> panic "getPrimOpResultInfo"
2317 Just (tc,_,_) -> ReturnsAlg tc
2318 other -> ReturnsPrim other
2321 The commutable ops are those for which we will try to move constants
2322 to the right hand side for strength reduction.
2325 commutableOp :: PrimOp -> Bool
2327 commutableOp CharEqOp = True
2328 commutableOp CharNeOp = True
2329 commutableOp IntAddOp = True
2330 commutableOp IntMulOp = True
2331 commutableOp AndOp = True
2332 commutableOp OrOp = True
2333 commutableOp XorOp = True
2334 commutableOp IntEqOp = True
2335 commutableOp IntNeOp = True
2336 commutableOp IntegerAddOp = True
2337 commutableOp IntegerMulOp = True
2338 commutableOp IntegerGcdOp = True
2339 commutableOp IntegerIntGcdOp = True
2340 commutableOp FloatAddOp = True
2341 commutableOp FloatMulOp = True
2342 commutableOp FloatEqOp = True
2343 commutableOp FloatNeOp = True
2344 commutableOp DoubleAddOp = True
2345 commutableOp DoubleMulOp = True
2346 commutableOp DoubleEqOp = True
2347 commutableOp DoubleNeOp = True
2348 commutableOp _ = False
2353 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2354 -- CharRep --> ([], Char#)
2355 -- StablePtrRep --> ([a], StablePtr# a)
2356 mkPrimTyApp tvs kind
2357 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2359 tycon = primRepTyCon kind
2360 forall_tvs = take (tyConArity tycon) tvs
2362 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2363 monadic_fun_ty ty = mkFunTy ty ty
2364 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2369 pprPrimOp :: PrimOp -> SDoc
2371 pprPrimOp (CCallOp ccall) = pprCCallOp ccall
2373 = getPprStyle $ \ sty ->
2374 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2375 ptext SLIT("PrelGHC.") <> pprOccName occ
2379 occ = primOpOcc other_op
2386 %************************************************************************
2388 \subsubsection{CCalls}
2390 %************************************************************************
2392 A special ``trap-door'' to use in making calls direct to C functions:
2396 Bool -- True <=> really a "casm"
2397 Bool -- True <=> might invoke Haskell GC
2398 CallConv -- calling convention to use.
2401 = StaticTarget FAST_STRING -- An "unboxed" ccall# to `fn'.
2402 | DynamicTarget Unique -- First argument (an Addr#) is the function pointer
2403 -- (unique is used to generate a 'typedef' to cast
2404 -- the function pointer if compiling the ccall# down to
2405 -- .hc code - can't do this inline for tedious reasons.)
2407 ccallMayGC :: CCall -> Bool
2408 ccallMayGC (CCall _ _ may_gc _) = may_gc
2410 ccallIsCasm :: CCall -> Bool
2411 ccallIsCasm (CCall _ c_asm _ _) = c_asm
2415 pprCCallOp (CCall fun is_casm may_gc cconv)
2416 = hcat [ ifPprDebug callconv
2417 , text "__", ppr_dyn
2418 , text before , ppr_fun , after]
2420 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2423 | is_casm && may_gc = "casm_GC ``"
2424 | is_casm = "casm ``"
2425 | may_gc = "ccall_GC "
2426 | otherwise = "ccall "
2429 | is_casm = text "''"
2432 ppr_dyn = case fun of
2433 DynamicTarget _ -> text "dyn_"
2436 ppr_fun = case fun of
2437 DynamicTarget _ -> text "\"\""
2438 StaticTarget fn -> ptext fn