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 CStrings ( CLabelString, pprCLabelString )
47 import PrelMods ( pREL_GHC, pREL_GHC_Name )
49 import Util ( assoc, zipWithEqual )
50 import GlaExts ( Int(..), Int#, (==#) )
53 %************************************************************************
55 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
57 %************************************************************************
59 These are in \tr{state-interface.verb} order.
63 -- dig the FORTRAN/C influence on the names...
67 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
68 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
69 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
70 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
71 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
72 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
78 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
80 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
87 | WordQuotOp | WordRemOp
88 | AndOp | OrOp | NotOp | XorOp
89 | SllOp | SrlOp -- shift {left,right} {logical}
90 | Int2WordOp | Word2IntOp -- casts
93 | Int2AddrOp | Addr2IntOp -- casts
95 -- Float#-related ops:
96 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
97 | Float2IntOp | Int2FloatOp
99 | FloatExpOp | FloatLogOp | FloatSqrtOp
100 | FloatSinOp | FloatCosOp | FloatTanOp
101 | FloatAsinOp | FloatAcosOp | FloatAtanOp
102 | FloatSinhOp | FloatCoshOp | FloatTanhOp
103 -- not all machines have these available conveniently:
104 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
105 | FloatPowerOp -- ** op
107 -- Double#-related ops:
108 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
109 | Double2IntOp | Int2DoubleOp
110 | Double2FloatOp | Float2DoubleOp
112 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
113 | DoubleSinOp | DoubleCosOp | DoubleTanOp
114 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
115 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
116 -- not all machines have these available conveniently:
117 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
118 | DoublePowerOp -- ** op
120 -- Integer (and related...) ops:
121 -- slightly weird -- to match GMP package.
122 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
123 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
124 | IntegerIntGcdOp | IntegerDivExactOp
125 | IntegerQuotOp | IntegerRemOp
130 | Integer2IntOp | Integer2WordOp
131 | Int2IntegerOp | Word2IntegerOp
133 -- casting to/from Integer and 64-bit (un)signed quantities.
134 | IntegerToInt64Op | Int64ToIntegerOp
135 | IntegerToWord64Op | Word64ToIntegerOp
141 -- primitive ops for primitive arrays
144 | NewByteArrayOp PrimRep
147 | SameMutableByteArrayOp
149 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
151 | ReadByteArrayOp PrimRep
152 | WriteByteArrayOp PrimRep
153 | IndexByteArrayOp PrimRep
154 | ReadOffAddrOp PrimRep
155 | WriteOffAddrOp PrimRep
156 | IndexOffAddrOp PrimRep
157 -- PrimRep can be one of :
158 -- {Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep.
159 -- This is just a cheesy encoding of a bunch of ops.
160 -- Note that ForeignObjRep is not included -- the only way of
161 -- creating a ForeignObj is with a ccall or casm.
162 | IndexOffForeignObjOp PrimRep
164 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
166 | SizeofByteArrayOp | SizeofMutableByteArrayOp
184 | BlockAsyncExceptionsOp
185 | UnblockAsyncExceptionsOp
208 -- Operation to test two closure addresses for equality (yes really!)
209 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
210 | ReallyUnsafePtrEqualityOp
225 -- more parallel stuff
226 | ParGlobalOp -- named global par
227 | ParLocalOp -- named local par
228 | ParAtOp -- specifies destination of local par
229 | ParAtAbsOp -- specifies destination of local par (abs processor)
230 | ParAtRelOp -- specifies destination of local par (rel processor)
231 | ParAtForNowOp -- specifies initial destination of global par
232 | CopyableOp -- marks copyable code
233 | NoFollowOp -- marks non-followup expression
240 Used for the Ord instance
243 primOpTag :: PrimOp -> Int
244 primOpTag op = IBOX( tagOf_PrimOp op )
246 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
247 tagOf_PrimOp CharGeOp = ILIT( 2)
248 tagOf_PrimOp CharEqOp = ILIT( 3)
249 tagOf_PrimOp CharNeOp = ILIT( 4)
250 tagOf_PrimOp CharLtOp = ILIT( 5)
251 tagOf_PrimOp CharLeOp = ILIT( 6)
252 tagOf_PrimOp IntGtOp = ILIT( 7)
253 tagOf_PrimOp IntGeOp = ILIT( 8)
254 tagOf_PrimOp IntEqOp = ILIT( 9)
255 tagOf_PrimOp IntNeOp = ILIT( 10)
256 tagOf_PrimOp IntLtOp = ILIT( 11)
257 tagOf_PrimOp IntLeOp = ILIT( 12)
258 tagOf_PrimOp WordGtOp = ILIT( 13)
259 tagOf_PrimOp WordGeOp = ILIT( 14)
260 tagOf_PrimOp WordEqOp = ILIT( 15)
261 tagOf_PrimOp WordNeOp = ILIT( 16)
262 tagOf_PrimOp WordLtOp = ILIT( 17)
263 tagOf_PrimOp WordLeOp = ILIT( 18)
264 tagOf_PrimOp AddrGtOp = ILIT( 19)
265 tagOf_PrimOp AddrGeOp = ILIT( 20)
266 tagOf_PrimOp AddrEqOp = ILIT( 21)
267 tagOf_PrimOp AddrNeOp = ILIT( 22)
268 tagOf_PrimOp AddrLtOp = ILIT( 23)
269 tagOf_PrimOp AddrLeOp = ILIT( 24)
270 tagOf_PrimOp FloatGtOp = ILIT( 25)
271 tagOf_PrimOp FloatGeOp = ILIT( 26)
272 tagOf_PrimOp FloatEqOp = ILIT( 27)
273 tagOf_PrimOp FloatNeOp = ILIT( 28)
274 tagOf_PrimOp FloatLtOp = ILIT( 29)
275 tagOf_PrimOp FloatLeOp = ILIT( 30)
276 tagOf_PrimOp DoubleGtOp = ILIT( 31)
277 tagOf_PrimOp DoubleGeOp = ILIT( 32)
278 tagOf_PrimOp DoubleEqOp = ILIT( 33)
279 tagOf_PrimOp DoubleNeOp = ILIT( 34)
280 tagOf_PrimOp DoubleLtOp = ILIT( 35)
281 tagOf_PrimOp DoubleLeOp = ILIT( 36)
282 tagOf_PrimOp OrdOp = ILIT( 37)
283 tagOf_PrimOp ChrOp = ILIT( 38)
284 tagOf_PrimOp IntAddOp = ILIT( 39)
285 tagOf_PrimOp IntSubOp = ILIT( 40)
286 tagOf_PrimOp IntMulOp = ILIT( 41)
287 tagOf_PrimOp IntQuotOp = ILIT( 42)
288 tagOf_PrimOp IntGcdOp = ILIT( 43)
289 tagOf_PrimOp IntRemOp = ILIT( 44)
290 tagOf_PrimOp IntNegOp = ILIT( 45)
291 tagOf_PrimOp WordQuotOp = ILIT( 47)
292 tagOf_PrimOp WordRemOp = ILIT( 48)
293 tagOf_PrimOp AndOp = ILIT( 49)
294 tagOf_PrimOp OrOp = ILIT( 50)
295 tagOf_PrimOp NotOp = ILIT( 51)
296 tagOf_PrimOp XorOp = ILIT( 52)
297 tagOf_PrimOp SllOp = ILIT( 53)
298 tagOf_PrimOp SrlOp = ILIT( 54)
299 tagOf_PrimOp ISllOp = ILIT( 55)
300 tagOf_PrimOp ISraOp = ILIT( 56)
301 tagOf_PrimOp ISrlOp = ILIT( 57)
302 tagOf_PrimOp IntAddCOp = ILIT( 58)
303 tagOf_PrimOp IntSubCOp = ILIT( 59)
304 tagOf_PrimOp IntMulCOp = ILIT( 60)
305 tagOf_PrimOp Int2WordOp = ILIT( 61)
306 tagOf_PrimOp Word2IntOp = ILIT( 62)
307 tagOf_PrimOp Int2AddrOp = ILIT( 63)
308 tagOf_PrimOp Addr2IntOp = ILIT( 64)
309 tagOf_PrimOp FloatAddOp = ILIT( 65)
310 tagOf_PrimOp FloatSubOp = ILIT( 66)
311 tagOf_PrimOp FloatMulOp = ILIT( 67)
312 tagOf_PrimOp FloatDivOp = ILIT( 68)
313 tagOf_PrimOp FloatNegOp = ILIT( 69)
314 tagOf_PrimOp Float2IntOp = ILIT( 70)
315 tagOf_PrimOp Int2FloatOp = ILIT( 71)
316 tagOf_PrimOp FloatExpOp = ILIT( 72)
317 tagOf_PrimOp FloatLogOp = ILIT( 73)
318 tagOf_PrimOp FloatSqrtOp = ILIT( 74)
319 tagOf_PrimOp FloatSinOp = ILIT( 75)
320 tagOf_PrimOp FloatCosOp = ILIT( 76)
321 tagOf_PrimOp FloatTanOp = ILIT( 77)
322 tagOf_PrimOp FloatAsinOp = ILIT( 78)
323 tagOf_PrimOp FloatAcosOp = ILIT( 79)
324 tagOf_PrimOp FloatAtanOp = ILIT( 80)
325 tagOf_PrimOp FloatSinhOp = ILIT( 81)
326 tagOf_PrimOp FloatCoshOp = ILIT( 82)
327 tagOf_PrimOp FloatTanhOp = ILIT( 83)
328 tagOf_PrimOp FloatPowerOp = ILIT( 84)
329 tagOf_PrimOp DoubleAddOp = ILIT( 85)
330 tagOf_PrimOp DoubleSubOp = ILIT( 86)
331 tagOf_PrimOp DoubleMulOp = ILIT( 87)
332 tagOf_PrimOp DoubleDivOp = ILIT( 88)
333 tagOf_PrimOp DoubleNegOp = ILIT( 89)
334 tagOf_PrimOp Double2IntOp = ILIT( 90)
335 tagOf_PrimOp Int2DoubleOp = ILIT( 91)
336 tagOf_PrimOp Double2FloatOp = ILIT( 92)
337 tagOf_PrimOp Float2DoubleOp = ILIT( 93)
338 tagOf_PrimOp DoubleExpOp = ILIT( 94)
339 tagOf_PrimOp DoubleLogOp = ILIT( 95)
340 tagOf_PrimOp DoubleSqrtOp = ILIT( 96)
341 tagOf_PrimOp DoubleSinOp = ILIT( 97)
342 tagOf_PrimOp DoubleCosOp = ILIT( 98)
343 tagOf_PrimOp DoubleTanOp = ILIT( 99)
344 tagOf_PrimOp DoubleAsinOp = ILIT(100)
345 tagOf_PrimOp DoubleAcosOp = ILIT(101)
346 tagOf_PrimOp DoubleAtanOp = ILIT(102)
347 tagOf_PrimOp DoubleSinhOp = ILIT(103)
348 tagOf_PrimOp DoubleCoshOp = ILIT(104)
349 tagOf_PrimOp DoubleTanhOp = ILIT(105)
350 tagOf_PrimOp DoublePowerOp = ILIT(106)
351 tagOf_PrimOp IntegerAddOp = ILIT(107)
352 tagOf_PrimOp IntegerSubOp = ILIT(108)
353 tagOf_PrimOp IntegerMulOp = ILIT(109)
354 tagOf_PrimOp IntegerGcdOp = ILIT(110)
355 tagOf_PrimOp IntegerIntGcdOp = ILIT(111)
356 tagOf_PrimOp IntegerDivExactOp = ILIT(112)
357 tagOf_PrimOp IntegerQuotOp = ILIT(113)
358 tagOf_PrimOp IntegerRemOp = ILIT(114)
359 tagOf_PrimOp IntegerQuotRemOp = ILIT(115)
360 tagOf_PrimOp IntegerDivModOp = ILIT(116)
361 tagOf_PrimOp IntegerNegOp = ILIT(117)
362 tagOf_PrimOp IntegerCmpOp = ILIT(118)
363 tagOf_PrimOp IntegerCmpIntOp = ILIT(119)
364 tagOf_PrimOp Integer2IntOp = ILIT(120)
365 tagOf_PrimOp Integer2WordOp = ILIT(121)
366 tagOf_PrimOp Int2IntegerOp = ILIT(122)
367 tagOf_PrimOp Word2IntegerOp = ILIT(123)
368 tagOf_PrimOp Addr2IntegerOp = ILIT(125)
369 tagOf_PrimOp IntegerToInt64Op = ILIT(127)
370 tagOf_PrimOp Int64ToIntegerOp = ILIT(128)
371 tagOf_PrimOp IntegerToWord64Op = ILIT(129)
372 tagOf_PrimOp Word64ToIntegerOp = ILIT(130)
373 tagOf_PrimOp FloatDecodeOp = ILIT(131)
374 tagOf_PrimOp DoubleDecodeOp = ILIT(132)
375 tagOf_PrimOp NewArrayOp = ILIT(133)
376 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134)
377 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135)
378 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136)
379 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137)
380 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138)
381 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139)
382 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140)
383 tagOf_PrimOp SameMutableArrayOp = ILIT(141)
384 tagOf_PrimOp SameMutableByteArrayOp = ILIT(142)
385 tagOf_PrimOp ReadArrayOp = ILIT(143)
386 tagOf_PrimOp WriteArrayOp = ILIT(144)
387 tagOf_PrimOp IndexArrayOp = ILIT(145)
388 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146)
389 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147)
390 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148)
391 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149)
392 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150)
393 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151)
394 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152)
395 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153)
396 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154)
397 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155)
398 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156)
399 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157)
400 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158)
401 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159)
402 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160)
403 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161)
404 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162)
405 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163)
406 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164)
407 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165)
408 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166)
409 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167)
410 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168)
411 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169)
412 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170)
413 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171)
414 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172)
415 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173)
416 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174)
417 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175)
418 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176)
419 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177)
420 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178)
421 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179)
422 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180)
423 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181)
424 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182)
425 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183)
426 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184)
427 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185)
428 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186)
429 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
430 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
431 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189)
432 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
433 tagOf_PrimOp (ReadOffAddrOp CharRep) = ILIT(191)
434 tagOf_PrimOp (ReadOffAddrOp IntRep) = ILIT(192)
435 tagOf_PrimOp (ReadOffAddrOp WordRep) = ILIT(193)
436 tagOf_PrimOp (ReadOffAddrOp AddrRep) = ILIT(194)
437 tagOf_PrimOp (ReadOffAddrOp FloatRep) = ILIT(195)
438 tagOf_PrimOp (ReadOffAddrOp DoubleRep) = ILIT(196)
439 tagOf_PrimOp (ReadOffAddrOp StablePtrRep) = ILIT(197)
440 tagOf_PrimOp (ReadOffAddrOp ForeignObjRep) = ILIT(198)
441 tagOf_PrimOp (ReadOffAddrOp Int64Rep) = ILIT(199)
442 tagOf_PrimOp (ReadOffAddrOp Word64Rep) = ILIT(200)
443 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(201)
444 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(202)
445 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(203)
446 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(205)
447 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(206)
448 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(207)
449 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(208)
450 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(209)
451 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(210)
452 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(211)
453 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(212)
454 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(213)
455 tagOf_PrimOp UnsafeThawArrayOp = ILIT(214)
456 tagOf_PrimOp SizeofByteArrayOp = ILIT(215)
457 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(216)
458 tagOf_PrimOp NewMVarOp = ILIT(217)
459 tagOf_PrimOp TakeMVarOp = ILIT(218)
460 tagOf_PrimOp PutMVarOp = ILIT(219)
461 tagOf_PrimOp SameMVarOp = ILIT(220)
462 tagOf_PrimOp IsEmptyMVarOp = ILIT(221)
463 tagOf_PrimOp MkForeignObjOp = ILIT(222)
464 tagOf_PrimOp WriteForeignObjOp = ILIT(223)
465 tagOf_PrimOp MkWeakOp = ILIT(224)
466 tagOf_PrimOp DeRefWeakOp = ILIT(225)
467 tagOf_PrimOp FinalizeWeakOp = ILIT(226)
468 tagOf_PrimOp MakeStableNameOp = ILIT(227)
469 tagOf_PrimOp EqStableNameOp = ILIT(228)
470 tagOf_PrimOp StableNameToIntOp = ILIT(229)
471 tagOf_PrimOp MakeStablePtrOp = ILIT(230)
472 tagOf_PrimOp DeRefStablePtrOp = ILIT(231)
473 tagOf_PrimOp EqStablePtrOp = ILIT(232)
474 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(234)
475 tagOf_PrimOp SeqOp = ILIT(235)
476 tagOf_PrimOp ParOp = ILIT(236)
477 tagOf_PrimOp ForkOp = ILIT(237)
478 tagOf_PrimOp KillThreadOp = ILIT(238)
479 tagOf_PrimOp YieldOp = ILIT(239)
480 tagOf_PrimOp MyThreadIdOp = ILIT(240)
481 tagOf_PrimOp DelayOp = ILIT(241)
482 tagOf_PrimOp WaitReadOp = ILIT(242)
483 tagOf_PrimOp WaitWriteOp = ILIT(243)
484 tagOf_PrimOp ParGlobalOp = ILIT(244)
485 tagOf_PrimOp ParLocalOp = ILIT(245)
486 tagOf_PrimOp ParAtOp = ILIT(246)
487 tagOf_PrimOp ParAtAbsOp = ILIT(247)
488 tagOf_PrimOp ParAtRelOp = ILIT(248)
489 tagOf_PrimOp ParAtForNowOp = ILIT(249)
490 tagOf_PrimOp CopyableOp = ILIT(250)
491 tagOf_PrimOp NoFollowOp = ILIT(251)
492 tagOf_PrimOp NewMutVarOp = ILIT(252)
493 tagOf_PrimOp ReadMutVarOp = ILIT(253)
494 tagOf_PrimOp WriteMutVarOp = ILIT(254)
495 tagOf_PrimOp SameMutVarOp = ILIT(255)
496 tagOf_PrimOp CatchOp = ILIT(256)
497 tagOf_PrimOp RaiseOp = ILIT(257)
498 tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(258)
499 tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(259)
500 tagOf_PrimOp DataToTagOp = ILIT(260)
501 tagOf_PrimOp TagToEnumOp = ILIT(261)
503 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
505 instance Eq PrimOp where
506 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
508 instance Ord PrimOp where
509 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
510 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
511 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
512 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
513 op1 `compare` op2 | op1 < op2 = LT
517 instance Outputable PrimOp where
518 ppr op = pprPrimOp op
520 instance Show PrimOp where
521 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
524 An @Enum@-derived list would be better; meanwhile... (ToDo)
526 allThePrimOps -- Except CCall, which is really a family of primops
658 NewByteArrayOp CharRep,
659 NewByteArrayOp IntRep,
660 NewByteArrayOp WordRep,
661 NewByteArrayOp AddrRep,
662 NewByteArrayOp FloatRep,
663 NewByteArrayOp DoubleRep,
664 NewByteArrayOp StablePtrRep,
666 SameMutableByteArrayOp,
670 ReadByteArrayOp CharRep,
671 ReadByteArrayOp IntRep,
672 ReadByteArrayOp WordRep,
673 ReadByteArrayOp AddrRep,
674 ReadByteArrayOp FloatRep,
675 ReadByteArrayOp DoubleRep,
676 ReadByteArrayOp StablePtrRep,
677 ReadByteArrayOp Int64Rep,
678 ReadByteArrayOp Word64Rep,
679 WriteByteArrayOp CharRep,
680 WriteByteArrayOp IntRep,
681 WriteByteArrayOp WordRep,
682 WriteByteArrayOp AddrRep,
683 WriteByteArrayOp FloatRep,
684 WriteByteArrayOp DoubleRep,
685 WriteByteArrayOp StablePtrRep,
686 WriteByteArrayOp Int64Rep,
687 WriteByteArrayOp Word64Rep,
688 IndexByteArrayOp CharRep,
689 IndexByteArrayOp IntRep,
690 IndexByteArrayOp WordRep,
691 IndexByteArrayOp AddrRep,
692 IndexByteArrayOp FloatRep,
693 IndexByteArrayOp DoubleRep,
694 IndexByteArrayOp StablePtrRep,
695 IndexByteArrayOp Int64Rep,
696 IndexByteArrayOp Word64Rep,
697 IndexOffForeignObjOp CharRep,
698 IndexOffForeignObjOp AddrRep,
699 IndexOffForeignObjOp IntRep,
700 IndexOffForeignObjOp WordRep,
701 IndexOffForeignObjOp FloatRep,
702 IndexOffForeignObjOp DoubleRep,
703 IndexOffForeignObjOp StablePtrRep,
704 IndexOffForeignObjOp Int64Rep,
705 IndexOffForeignObjOp Word64Rep,
706 IndexOffAddrOp CharRep,
707 IndexOffAddrOp IntRep,
708 IndexOffAddrOp WordRep,
709 IndexOffAddrOp AddrRep,
710 IndexOffAddrOp FloatRep,
711 IndexOffAddrOp DoubleRep,
712 IndexOffAddrOp StablePtrRep,
713 IndexOffAddrOp Int64Rep,
714 IndexOffAddrOp Word64Rep,
715 ReadOffAddrOp CharRep,
716 ReadOffAddrOp IntRep,
717 ReadOffAddrOp WordRep,
718 ReadOffAddrOp AddrRep,
719 ReadOffAddrOp FloatRep,
720 ReadOffAddrOp DoubleRep,
721 ReadOffAddrOp ForeignObjRep,
722 ReadOffAddrOp StablePtrRep,
723 ReadOffAddrOp Int64Rep,
724 ReadOffAddrOp Word64Rep,
725 WriteOffAddrOp CharRep,
726 WriteOffAddrOp IntRep,
727 WriteOffAddrOp WordRep,
728 WriteOffAddrOp AddrRep,
729 WriteOffAddrOp FloatRep,
730 WriteOffAddrOp DoubleRep,
731 WriteOffAddrOp ForeignObjRep,
732 WriteOffAddrOp StablePtrRep,
733 WriteOffAddrOp Int64Rep,
734 WriteOffAddrOp Word64Rep,
736 UnsafeFreezeByteArrayOp,
739 SizeofMutableByteArrayOp,
746 BlockAsyncExceptionsOp,
747 UnblockAsyncExceptionsOp,
764 ReallyUnsafePtrEqualityOp,
787 %************************************************************************
789 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
791 %************************************************************************
793 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
794 refer to the primitive operation. The conventional \tr{#}-for-
795 unboxed ops is added on later.
797 The reason for the funny characters in the names is so we do not
798 interfere with the programmer's Haskell name spaces.
800 We use @PrimKinds@ for the ``type'' information, because they're
801 (slightly) more convenient to use than @TyCons@.
804 = Dyadic OccName -- string :: T -> T -> T
806 | Monadic OccName -- string :: T -> T
808 | Compare OccName -- string :: T -> T -> Bool
811 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
816 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
817 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
818 mkCompare str ty = Compare (mkSrcVarOcc str) ty
819 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
824 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
826 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
827 intPrimTy, byteArrayPrimTy] -- second '' pieces
828 an_Integer_and_Int_tys
829 = [intPrimTy, byteArrayPrimTy, -- Integer
832 unboxedPair = mkUnboxedTupleTy 2
833 unboxedTriple = mkUnboxedTupleTy 3
834 unboxedQuadruple = mkUnboxedTupleTy 4
836 mkIOTy ty = mkFunTy realWorldStatePrimTy
837 (unboxedPair [realWorldStatePrimTy,ty])
839 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
840 (unboxedPair one_Integer_ty)
842 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
843 (unboxedPair one_Integer_ty)
845 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
846 (unboxedQuadruple two_Integer_tys)
848 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
851 %************************************************************************
853 \subsubsection{Strictness}
855 %************************************************************************
857 Not all primops are strict!
860 primOpStrictness :: Arity -> PrimOp -> StrictnessInfo
861 -- See Demand.StrictnessInfo for discussion of what the results
862 -- The arity should be the arity of the primop; that's why
863 -- this function isn't exported.
865 primOpStrictness arity SeqOp = StrictnessInfo [wwStrict] False
866 -- Seq is strict in its argument; see notes in ConFold.lhs
868 primOpStrictness arity ParOp = StrictnessInfo [wwLazy] False
869 -- Note that Par is lazy to avoid that the sparked thing
870 -- gets evaluted strictly, which it should *not* be
872 primOpStrictness arity ForkOp = StrictnessInfo [wwLazy, wwPrim] False
874 primOpStrictness arity NewArrayOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
875 primOpStrictness arity WriteArrayOp = StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False
877 primOpStrictness arity NewMutVarOp = StrictnessInfo [wwLazy, wwPrim] False
878 primOpStrictness arity WriteMutVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
880 primOpStrictness arity PutMVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
882 primOpStrictness arity CatchOp = StrictnessInfo [wwLazy, wwLazy, wwPrim] False
883 -- Catch is actually strict in its first argument
884 -- but we don't want to tell the strictness
885 -- analyser about that!
887 primOpStrictness arity RaiseOp = StrictnessInfo [wwLazy] True -- NB: True => result is bottom
888 primOpStrictness arity BlockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
889 primOpStrictness arity UnblockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
891 primOpStrictness arity MkWeakOp = StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False
892 primOpStrictness arity MakeStableNameOp = StrictnessInfo [wwLazy, wwPrim] False
893 primOpStrictness arity MakeStablePtrOp = StrictnessInfo [wwLazy, wwPrim] False
895 primOpStrictness arity DataToTagOp = StrictnessInfo [wwLazy] False
897 -- The rest all have primitive-typed arguments
898 primOpStrictness arity other = StrictnessInfo (replicate arity wwPrim) False
901 %************************************************************************
903 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
905 %************************************************************************
907 @primOpInfo@ gives all essential information (from which everything
908 else, notably a type, can be constructed) for each @PrimOp@.
911 primOpInfo :: PrimOp -> PrimOpInfo
914 There's plenty of this stuff!
917 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
918 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
919 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
920 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
921 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
922 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
924 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
925 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
926 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
927 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
928 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
929 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
931 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
932 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
933 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
934 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
935 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
936 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
938 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
939 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
940 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
941 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
942 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
943 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
945 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
946 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
947 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
948 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
949 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
950 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
952 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
953 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
954 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
955 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
956 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
957 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
961 %************************************************************************
963 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
965 %************************************************************************
968 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
969 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
972 %************************************************************************
974 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
976 %************************************************************************
979 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
980 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
981 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
982 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
983 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
984 primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
986 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
988 primOpInfo IntAddCOp =
989 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
990 (unboxedPair [intPrimTy, intPrimTy])
992 primOpInfo IntSubCOp =
993 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
994 (unboxedPair [intPrimTy, intPrimTy])
996 primOpInfo IntMulCOp =
997 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
998 (unboxedPair [intPrimTy, intPrimTy])
1001 %************************************************************************
1003 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1005 %************************************************************************
1007 A @Word#@ is an unsigned @Int#@.
1010 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1011 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1013 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1014 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1015 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1016 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1019 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1021 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1024 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1026 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1028 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1030 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1031 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1034 %************************************************************************
1036 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1038 %************************************************************************
1041 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1042 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1046 %************************************************************************
1048 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1050 %************************************************************************
1052 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1055 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1056 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1057 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1058 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1059 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1061 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1062 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1064 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1065 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1066 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1067 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1068 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1069 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1070 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1071 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1072 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1073 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1074 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1075 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1076 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1079 %************************************************************************
1081 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1083 %************************************************************************
1085 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1088 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1089 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1090 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1091 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1092 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1094 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1095 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1097 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1098 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1100 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1101 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1102 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1103 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1104 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1105 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1106 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1107 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1108 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1109 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1110 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1111 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1112 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1115 %************************************************************************
1117 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1119 %************************************************************************
1122 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1124 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1125 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1126 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1127 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1128 primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1129 primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
1130 primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
1131 primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
1133 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1134 primOpInfo IntegerCmpIntOp
1135 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1137 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1138 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1140 primOpInfo Integer2IntOp
1141 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1143 primOpInfo Integer2WordOp
1144 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1146 primOpInfo Int2IntegerOp
1147 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1148 (unboxedPair one_Integer_ty)
1150 primOpInfo Word2IntegerOp
1151 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1152 (unboxedPair one_Integer_ty)
1154 primOpInfo Addr2IntegerOp
1155 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1156 (unboxedPair one_Integer_ty)
1158 primOpInfo IntegerToInt64Op
1159 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1161 primOpInfo Int64ToIntegerOp
1162 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1163 (unboxedPair one_Integer_ty)
1165 primOpInfo Word64ToIntegerOp
1166 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1167 (unboxedPair one_Integer_ty)
1169 primOpInfo IntegerToWord64Op
1170 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1173 Decoding of floating-point numbers is sorta Integer-related. Encoding
1174 is done with plain ccalls now (see PrelNumExtra.lhs).
1177 primOpInfo FloatDecodeOp
1178 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1179 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1180 primOpInfo DoubleDecodeOp
1181 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1182 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1185 %************************************************************************
1187 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1189 %************************************************************************
1192 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1193 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1197 primOpInfo NewArrayOp
1199 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1200 state = mkStatePrimTy s
1202 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1203 [intPrimTy, elt, state]
1204 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1206 primOpInfo (NewByteArrayOp kind)
1208 s = alphaTy; s_tv = alphaTyVar
1210 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1211 state = mkStatePrimTy s
1213 mkGenPrimOp op_str [s_tv]
1215 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1217 ---------------------------------------------------------------------------
1220 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1221 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1224 primOpInfo SameMutableArrayOp
1226 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1227 mut_arr_ty = mkMutableArrayPrimTy s elt
1229 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1232 primOpInfo SameMutableByteArrayOp
1234 s = alphaTy; s_tv = alphaTyVar;
1235 mut_arr_ty = mkMutableByteArrayPrimTy s
1237 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1240 ---------------------------------------------------------------------------
1241 -- Primitive arrays of Haskell pointers:
1244 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1245 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1246 indexArray# :: Array# a -> Int# -> (# a #)
1249 primOpInfo ReadArrayOp
1251 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1252 state = mkStatePrimTy s
1254 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1255 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1256 (unboxedPair [state, elt])
1259 primOpInfo WriteArrayOp
1261 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1263 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1264 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1267 primOpInfo IndexArrayOp
1268 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1269 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1270 (mkUnboxedTupleTy 1 [elt])
1272 ---------------------------------------------------------------------------
1273 -- Primitive arrays full of unboxed bytes:
1275 primOpInfo (ReadByteArrayOp kind)
1277 s = alphaTy; s_tv = alphaTyVar
1279 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1280 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1281 state = mkStatePrimTy s
1283 mkGenPrimOp op_str (s_tv:tvs)
1284 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1285 (unboxedPair [state, prim_ty])
1287 primOpInfo (WriteByteArrayOp kind)
1289 s = alphaTy; s_tv = alphaTyVar
1290 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1291 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1293 mkGenPrimOp op_str (s_tv:tvs)
1294 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1297 primOpInfo (IndexByteArrayOp kind)
1299 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1300 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1302 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1304 primOpInfo (IndexOffForeignObjOp kind)
1306 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1307 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1309 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1311 primOpInfo (IndexOffAddrOp kind)
1313 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1314 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1316 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1318 primOpInfo (ReadOffAddrOp kind)
1320 s = alphaTy; s_tv = alphaTyVar
1321 op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#")
1322 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1323 state = mkStatePrimTy s
1325 mkGenPrimOp op_str (s_tv:tvs)
1326 [addrPrimTy, intPrimTy, state]
1327 (unboxedPair [state, prim_ty])
1329 primOpInfo (WriteOffAddrOp kind)
1331 s = alphaTy; s_tv = alphaTyVar
1332 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1333 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1335 mkGenPrimOp op_str (s_tv:tvs)
1336 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1339 ---------------------------------------------------------------------------
1341 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1342 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1343 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1346 primOpInfo UnsafeFreezeArrayOp
1348 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1349 state = mkStatePrimTy s
1351 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1352 [mkMutableArrayPrimTy s elt, state]
1353 (unboxedPair [state, mkArrayPrimTy elt])
1355 primOpInfo UnsafeFreezeByteArrayOp
1357 s = alphaTy; s_tv = alphaTyVar;
1358 state = mkStatePrimTy s
1360 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1361 [mkMutableByteArrayPrimTy s, state]
1362 (unboxedPair [state, byteArrayPrimTy])
1364 primOpInfo UnsafeThawArrayOp
1366 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1367 state = mkStatePrimTy s
1369 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
1370 [mkArrayPrimTy elt, state]
1371 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1373 ---------------------------------------------------------------------------
1374 primOpInfo SizeofByteArrayOp
1376 SLIT("sizeofByteArray#") []
1380 primOpInfo SizeofMutableByteArrayOp
1381 = let { s = alphaTy; s_tv = alphaTyVar } in
1383 SLIT("sizeofMutableByteArray#") [s_tv]
1384 [mkMutableByteArrayPrimTy s]
1389 %************************************************************************
1391 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1393 %************************************************************************
1396 primOpInfo NewMutVarOp
1398 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1399 state = mkStatePrimTy s
1401 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1403 (unboxedPair [state, mkMutVarPrimTy s elt])
1405 primOpInfo ReadMutVarOp
1407 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1408 state = mkStatePrimTy s
1410 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1411 [mkMutVarPrimTy s elt, state]
1412 (unboxedPair [state, elt])
1415 primOpInfo WriteMutVarOp
1417 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1419 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1420 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1423 primOpInfo SameMutVarOp
1425 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1426 mut_var_ty = mkMutVarPrimTy s elt
1428 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1432 %************************************************************************
1434 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1436 %************************************************************************
1438 catch# :: (State# RealWorld -> (# State# RealWorld, a))
1439 -> (b -> State# RealWorld -> (# State# RealWorld, a))
1441 -> (# State# RealWorld, a)
1443 throw :: Exception -> a
1446 blockAsyncExceptions# :: IO a -> IO a
1447 unblockAsyncExceptions# :: IO a -> IO a
1452 a = alphaTy; a_tv = alphaTyVar
1453 b = betaTy; b_tv = betaTyVar;
1456 mkGenPrimOp SLIT("catch#") [a_tv, b_tv]
1457 [io_a, mkFunTy b io_a, realWorldStatePrimTy]
1458 (unboxedPair [realWorldStatePrimTy, a])
1462 a = alphaTy; a_tv = alphaTyVar
1463 b = betaTy; b_tv = betaTyVar;
1465 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1467 primOpInfo BlockAsyncExceptionsOp
1469 a = alphaTy; a_tv = alphaTyVar
1471 mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
1472 [ mkIOTy a, realWorldStatePrimTy ]
1473 (unboxedPair [realWorldStatePrimTy,a])
1475 primOpInfo UnblockAsyncExceptionsOp
1477 a = alphaTy; a_tv = alphaTyVar
1479 mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
1480 [ mkIOTy a, realWorldStatePrimTy ]
1481 (unboxedPair [realWorldStatePrimTy,a])
1484 %************************************************************************
1486 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1488 %************************************************************************
1491 primOpInfo NewMVarOp
1493 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1494 state = mkStatePrimTy s
1496 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1497 (unboxedPair [state, mkMVarPrimTy s elt])
1499 primOpInfo TakeMVarOp
1501 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1502 state = mkStatePrimTy s
1504 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1505 [mkMVarPrimTy s elt, state]
1506 (unboxedPair [state, elt])
1508 primOpInfo PutMVarOp
1510 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1512 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1513 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1516 primOpInfo SameMVarOp
1518 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1519 mvar_ty = mkMVarPrimTy s elt
1521 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1523 primOpInfo IsEmptyMVarOp
1525 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1526 state = mkStatePrimTy s
1528 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1529 [mkMVarPrimTy s elt, mkStatePrimTy s]
1530 (unboxedPair [state, intPrimTy])
1534 %************************************************************************
1536 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1538 %************************************************************************
1544 s = alphaTy; s_tv = alphaTyVar
1546 mkGenPrimOp SLIT("delay#") [s_tv]
1547 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1549 primOpInfo WaitReadOp
1551 s = alphaTy; s_tv = alphaTyVar
1553 mkGenPrimOp SLIT("waitRead#") [s_tv]
1554 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1556 primOpInfo WaitWriteOp
1558 s = alphaTy; s_tv = alphaTyVar
1560 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1561 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1564 %************************************************************************
1566 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1568 %************************************************************************
1571 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1573 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1574 [alphaTy, realWorldStatePrimTy]
1575 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1577 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1578 primOpInfo KillThreadOp
1579 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1580 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1581 realWorldStatePrimTy
1583 -- yield# :: State# RealWorld -> State# RealWorld
1585 = mkGenPrimOp SLIT("yield#") []
1586 [realWorldStatePrimTy]
1587 realWorldStatePrimTy
1589 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1590 primOpInfo MyThreadIdOp
1591 = mkGenPrimOp SLIT("myThreadId#") []
1592 [realWorldStatePrimTy]
1593 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1596 ************************************************************************
1598 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1600 %************************************************************************
1603 primOpInfo MkForeignObjOp
1604 = mkGenPrimOp SLIT("mkForeignObj#") []
1605 [addrPrimTy, realWorldStatePrimTy]
1606 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1608 primOpInfo WriteForeignObjOp
1610 s = alphaTy; s_tv = alphaTyVar
1612 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1613 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1616 ************************************************************************
1618 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1620 %************************************************************************
1622 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1624 mkWeak# :: k -> v -> f -> State# RealWorld
1625 -> (# State# RealWorld, Weak# v #)
1627 In practice, you'll use the higher-level
1629 data Weak v = Weak# v
1630 mkWeak :: k -> v -> IO () -> IO (Weak v)
1634 = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
1635 [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
1636 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1639 The following operation dereferences a weak pointer. The weak pointer
1640 may have been finalized, so the operation returns a result code which
1641 must be inspected before looking at the dereferenced value.
1643 deRefWeak# :: Weak# v -> State# RealWorld ->
1644 (# State# RealWorld, v, Int# #)
1646 Only look at v if the Int# returned is /= 0 !!
1648 The higher-level op is
1650 deRefWeak :: Weak v -> IO (Maybe v)
1653 primOpInfo DeRefWeakOp
1654 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1655 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1656 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1659 Weak pointers can be finalized early by using the finalize# operation:
1661 finalizeWeak# :: Weak# v -> State# RealWorld ->
1662 (# State# RealWorld, Int#, IO () #)
1664 The Int# returned is either
1666 0 if the weak pointer has already been finalized, or it has no
1667 finalizer (the third component is then invalid).
1669 1 if the weak pointer is still alive, with the finalizer returned
1670 as the third component.
1673 primOpInfo FinalizeWeakOp
1674 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1675 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1676 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1677 mkFunTy realWorldStatePrimTy
1678 (unboxedPair [realWorldStatePrimTy,unitTy])])
1681 %************************************************************************
1683 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1685 %************************************************************************
1687 A {\em stable name/pointer} is an index into a table of stable name
1688 entries. Since the garbage collector is told about stable pointers,
1689 it is safe to pass a stable pointer to external systems such as C
1693 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1694 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1695 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1696 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1699 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1700 operation since it doesn't (directly) involve IO operations. The
1701 reason is that if some optimisation pass decided to duplicate calls to
1702 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1703 massive space leak can result. Putting it into the IO monad
1704 prevents this. (Another reason for putting them in a monad is to
1705 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1708 An important property of stable pointers is that if you call
1709 makeStablePtr# twice on the same object you get the same stable
1712 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1713 besides, it's not likely to be used from Haskell) so it's not a
1716 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1721 A stable name is like a stable pointer, but with three important differences:
1723 (a) You can't deRef one to get back to the original object.
1724 (b) You can convert one to an Int.
1725 (c) You don't need to 'freeStableName'
1727 The existence of a stable name doesn't guarantee to keep the object it
1728 points to alive (unlike a stable pointer), hence (a).
1732 (a) makeStableName always returns the same value for a given
1733 object (same as stable pointers).
1735 (b) if two stable names are equal, it implies that the objects
1736 from which they were created were the same.
1738 (c) stableNameToInt always returns the same Int for a given
1742 primOpInfo MakeStablePtrOp
1743 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1744 [alphaTy, realWorldStatePrimTy]
1745 (unboxedPair [realWorldStatePrimTy,
1746 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1748 primOpInfo DeRefStablePtrOp
1749 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1750 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1751 (unboxedPair [realWorldStatePrimTy, alphaTy])
1753 primOpInfo EqStablePtrOp
1754 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1755 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1758 primOpInfo MakeStableNameOp
1759 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1760 [alphaTy, realWorldStatePrimTy]
1761 (unboxedPair [realWorldStatePrimTy,
1762 mkTyConApp stableNamePrimTyCon [alphaTy]])
1764 primOpInfo EqStableNameOp
1765 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1766 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1769 primOpInfo StableNameToIntOp
1770 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1771 [mkStableNamePrimTy alphaTy]
1775 %************************************************************************
1777 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1779 %************************************************************************
1781 [Alastair Reid is to blame for this!]
1783 These days, (Glasgow) Haskell seems to have a bit of everything from
1784 other languages: strict operations, mutable variables, sequencing,
1785 pointers, etc. About the only thing left is LISP's ability to test
1786 for pointer equality. So, let's add it in!
1789 reallyUnsafePtrEquality :: a -> a -> Int#
1792 which tests any two closures (of the same type) to see if they're the
1793 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1794 difficulties of trying to box up the result.)
1796 NB This is {\em really unsafe\/} because even something as trivial as
1797 a garbage collection might change the answer by removing indirections.
1798 Still, no-one's forcing you to use it. If you're worried about little
1799 things like loss of referential transparency, you might like to wrap
1800 it all up in a monad-like thing as John O'Donnell and John Hughes did
1801 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1804 I'm thinking of using it to speed up a critical equality test in some
1805 graphics stuff in a context where the possibility of saying that
1806 denotationally equal things aren't isn't a problem (as long as it
1807 doesn't happen too often.) ADR
1809 To Will: Jim said this was already in, but I can't see it so I'm
1810 adding it. Up to you whether you add it. (Note that this could have
1811 been readily implemented using a @veryDangerousCCall@ before they were
1815 primOpInfo ReallyUnsafePtrEqualityOp
1816 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1817 [alphaTy, alphaTy] intPrimTy
1820 %************************************************************************
1822 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1824 %************************************************************************
1827 primOpInfo SeqOp -- seq# :: a -> Int#
1828 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1830 primOpInfo ParOp -- par# :: a -> Int#
1831 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1835 -- HWL: The first 4 Int# in all par... annotations denote:
1836 -- name, granularity info, size of result, degree of parallelism
1837 -- Same structure as _seq_ i.e. returns Int#
1838 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1839 -- `the processor containing the expression v'; it is not evaluated
1841 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1842 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1844 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1845 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1847 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1848 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1850 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1851 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1853 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1854 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1856 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1857 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1859 primOpInfo CopyableOp -- copyable# :: a -> Int#
1860 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1862 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1863 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1866 %************************************************************************
1868 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1870 %************************************************************************
1872 These primops are pretty wierd.
1874 dataToTag# :: a -> Int (arg must be an evaluated data type)
1875 tagToEnum# :: Int -> a (result type must be an enumerated type)
1877 The constraints aren't currently checked by the front end, but the
1878 code generator will fall over if they aren't satisfied.
1881 primOpInfo DataToTagOp
1882 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1884 primOpInfo TagToEnumOp
1885 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1888 primOpInfo op = pprPanic "primOpInfo:" (ppr op)
1892 %************************************************************************
1894 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1896 %************************************************************************
1898 Some PrimOps need to be called out-of-line because they either need to
1899 perform a heap check or they block.
1911 BlockAsyncExceptionsOp -> True
1912 UnblockAsyncExceptionsOp -> True
1914 NewByteArrayOp _ -> True
1915 IntegerAddOp -> True
1916 IntegerSubOp -> True
1917 IntegerMulOp -> True
1918 IntegerGcdOp -> True
1919 IntegerDivExactOp -> True
1920 IntegerQuotOp -> True
1921 IntegerRemOp -> True
1922 IntegerQuotRemOp -> True
1923 IntegerDivModOp -> True
1924 Int2IntegerOp -> True
1925 Word2IntegerOp -> True
1926 Addr2IntegerOp -> True
1927 Word64ToIntegerOp -> True
1928 Int64ToIntegerOp -> True
1929 FloatDecodeOp -> True
1930 DoubleDecodeOp -> True
1932 FinalizeWeakOp -> True
1933 MakeStableNameOp -> True
1934 MkForeignObjOp -> True
1938 KillThreadOp -> True
1941 UnsafeThawArrayOp -> True
1942 -- UnsafeThawArrayOp doesn't perform any heap checks,
1943 -- but it is of such an esoteric nature that
1944 -- it is done out-of-line rather than require
1945 -- the NCG to implement it.
1947 CCallOp c_call -> ccallMayGC c_call
1953 primOpOkForSpeculation
1954 ~~~~~~~~~~~~~~~~~~~~~~
1955 Sometimes we may choose to execute a PrimOp even though it isn't
1956 certain that its result will be required; ie execute them
1957 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1958 this is OK, because PrimOps are usually cheap, but it isn't OK for
1959 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1961 PrimOps that have side effects also should not be executed speculatively.
1963 Ok-for-speculation also means that it's ok *not* to execute the
1967 Here the result is not used, so we can discard the primop. Anything
1968 that has side effects mustn't be dicarded in this way, of course!
1970 See also @primOpIsCheap@ (below).
1974 primOpOkForSpeculation :: PrimOp -> Bool
1975 -- See comments with CoreUtils.exprOkForSpeculation
1976 primOpOkForSpeculation op
1977 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1983 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1984 WARNING), we just borrow some other predicates for a
1985 what-should-be-good-enough test. "Cheap" means willing to call it more
1986 than once. Evaluation order is unaffected.
1989 primOpIsCheap :: PrimOp -> Bool
1990 -- See comments with CoreUtils.exprOkForSpeculation
1991 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
1996 primOpIsDupable means that the use of the primop is small enough to
1997 duplicate into different case branches. See CoreUtils.exprIsDupable.
2000 primOpIsDupable :: PrimOp -> Bool
2001 -- See comments with CoreUtils.exprIsDupable
2002 -- We say it's dupable it isn't implemented by a C call with a wrapper
2003 primOpIsDupable op = not (primOpNeedsWrapper op)
2008 primOpCanFail :: PrimOp -> Bool
2010 primOpCanFail IntQuotOp = True -- Divide by zero
2011 primOpCanFail IntRemOp = True -- Divide by zero
2014 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2015 primOpCanFail IntegerDivModOp = True -- Divide by zero
2017 -- Float. ToDo: tan? tanh?
2018 primOpCanFail FloatDivOp = True -- Divide by zero
2019 primOpCanFail FloatLogOp = True -- Log of zero
2020 primOpCanFail FloatAsinOp = True -- Arg out of domain
2021 primOpCanFail FloatAcosOp = True -- Arg out of domain
2023 -- Double. ToDo: tan? tanh?
2024 primOpCanFail DoubleDivOp = True -- Divide by zero
2025 primOpCanFail DoubleLogOp = True -- Log of zero
2026 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2027 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2029 primOpCanFail other_op = False
2032 And some primops have side-effects and so, for example, must not be
2036 primOpHasSideEffects :: PrimOp -> Bool
2038 primOpHasSideEffects ParOp = True
2039 primOpHasSideEffects ForkOp = True
2040 primOpHasSideEffects KillThreadOp = True
2041 primOpHasSideEffects YieldOp = True
2042 primOpHasSideEffects SeqOp = True
2044 primOpHasSideEffects MkForeignObjOp = True
2045 primOpHasSideEffects WriteForeignObjOp = True
2046 primOpHasSideEffects MkWeakOp = True
2047 primOpHasSideEffects DeRefWeakOp = True
2048 primOpHasSideEffects FinalizeWeakOp = True
2049 primOpHasSideEffects MakeStablePtrOp = True
2050 primOpHasSideEffects MakeStableNameOp = True
2051 primOpHasSideEffects EqStablePtrOp = True -- SOF
2052 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2054 -- In general, writes are considered a side effect, but
2055 -- reads and variable allocations are not
2056 -- Why? Because writes must not be omitted, but reads can be if their result is not used.
2057 -- (Sequencing of reads is maintained by data dependencies on the resulting
2059 primOpHasSideEffects WriteArrayOp = True
2060 primOpHasSideEffects (WriteByteArrayOp _) = True
2061 primOpHasSideEffects (WriteOffAddrOp _) = True
2062 primOpHasSideEffects WriteMutVarOp = True
2064 primOpHasSideEffects UnsafeFreezeArrayOp = True
2065 primOpHasSideEffects UnsafeFreezeByteArrayOp = True
2066 primOpHasSideEffects UnsafeThawArrayOp = True
2068 primOpHasSideEffects TakeMVarOp = True
2069 primOpHasSideEffects PutMVarOp = True
2070 primOpHasSideEffects DelayOp = True
2071 primOpHasSideEffects WaitReadOp = True
2072 primOpHasSideEffects WaitWriteOp = True
2074 primOpHasSideEffects ParGlobalOp = True
2075 primOpHasSideEffects ParLocalOp = True
2076 primOpHasSideEffects ParAtOp = True
2077 primOpHasSideEffects ParAtAbsOp = True
2078 primOpHasSideEffects ParAtRelOp = True
2079 primOpHasSideEffects ParAtForNowOp = True
2080 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2081 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2082 primOpHasSideEffects (CCallOp _) = True
2084 primOpHasSideEffects other = False
2087 Inline primitive operations that perform calls need wrappers to save
2088 any live variables that are stored in caller-saves registers.
2091 primOpNeedsWrapper :: PrimOp -> Bool
2093 primOpNeedsWrapper (CCallOp _) = True
2095 primOpNeedsWrapper Integer2IntOp = True
2096 primOpNeedsWrapper Integer2WordOp = True
2097 primOpNeedsWrapper IntegerCmpOp = True
2098 primOpNeedsWrapper IntegerCmpIntOp = True
2100 primOpNeedsWrapper FloatExpOp = True
2101 primOpNeedsWrapper FloatLogOp = True
2102 primOpNeedsWrapper FloatSqrtOp = True
2103 primOpNeedsWrapper FloatSinOp = True
2104 primOpNeedsWrapper FloatCosOp = True
2105 primOpNeedsWrapper FloatTanOp = True
2106 primOpNeedsWrapper FloatAsinOp = True
2107 primOpNeedsWrapper FloatAcosOp = True
2108 primOpNeedsWrapper FloatAtanOp = True
2109 primOpNeedsWrapper FloatSinhOp = True
2110 primOpNeedsWrapper FloatCoshOp = True
2111 primOpNeedsWrapper FloatTanhOp = True
2112 primOpNeedsWrapper FloatPowerOp = True
2114 primOpNeedsWrapper DoubleExpOp = True
2115 primOpNeedsWrapper DoubleLogOp = True
2116 primOpNeedsWrapper DoubleSqrtOp = True
2117 primOpNeedsWrapper DoubleSinOp = True
2118 primOpNeedsWrapper DoubleCosOp = True
2119 primOpNeedsWrapper DoubleTanOp = True
2120 primOpNeedsWrapper DoubleAsinOp = True
2121 primOpNeedsWrapper DoubleAcosOp = True
2122 primOpNeedsWrapper DoubleAtanOp = True
2123 primOpNeedsWrapper DoubleSinhOp = True
2124 primOpNeedsWrapper DoubleCoshOp = True
2125 primOpNeedsWrapper DoubleTanhOp = True
2126 primOpNeedsWrapper DoublePowerOp = True
2128 primOpNeedsWrapper MakeStableNameOp = True
2129 primOpNeedsWrapper DeRefStablePtrOp = True
2131 primOpNeedsWrapper DelayOp = True
2132 primOpNeedsWrapper WaitReadOp = True
2133 primOpNeedsWrapper WaitWriteOp = True
2135 primOpNeedsWrapper other_op = False
2139 primOpArity :: PrimOp -> Arity
2141 = case (primOpInfo op) of
2145 GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
2147 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2149 = case (primOpInfo op) of
2150 Dyadic occ ty -> dyadic_fun_ty ty
2151 Monadic occ ty -> monadic_fun_ty ty
2152 Compare occ ty -> compare_fun_ty ty
2154 GenPrimOp occ tyvars arg_tys res_ty ->
2155 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2157 mkPrimOpIdName :: PrimOp -> Id -> Name
2158 -- Make the name for the PrimOp's Id
2159 -- We have to pass in the Id itself because it's a WiredInId
2160 -- and hence recursive
2161 mkPrimOpIdName op id
2162 = mkWiredInIdName key pREL_GHC occ_name id
2164 occ_name = primOpOcc op
2165 key = mkPrimOpIdUnique (primOpTag op)
2168 primOpRdrName :: PrimOp -> RdrName
2169 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2171 primOpOcc :: PrimOp -> OccName
2172 primOpOcc op = case (primOpInfo op) of
2174 Monadic occ _ -> occ
2175 Compare occ _ -> occ
2176 GenPrimOp occ _ _ _ -> occ
2178 -- primOpSig is like primOpType but gives the result split apart:
2179 -- (type variables, argument types, result type)
2180 -- It also gives arity, strictness info
2182 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
2184 = (tyvars, arg_tys, res_ty, arity, primOpStrictness arity op)
2186 arity = length arg_tys
2187 (tyvars, arg_tys, res_ty)
2188 = case (primOpInfo op) of
2189 Monadic occ ty -> ([], [ty], ty )
2190 Dyadic occ ty -> ([], [ty,ty], ty )
2191 Compare occ ty -> ([], [ty,ty], boolTy)
2192 GenPrimOp occ tyvars arg_tys res_ty
2193 -> (tyvars, arg_tys, res_ty)
2195 -- primOpUsg is like primOpSig but the types it yields are the
2196 -- appropriate sigma (i.e., usage-annotated) types,
2197 -- as required by the UsageSP inference.
2199 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2203 -- Refer to comment by `otherwise' clause; we need consider here
2204 -- *only* primops that have arguments or results containing Haskell
2205 -- pointers (things that are pointed). Unpointed values are
2206 -- irrelevant to the usage analysis. The issue is whether pointed
2207 -- values may be entered or duplicated by the primop.
2209 -- Remember that primops are *never* partially applied.
2211 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2212 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2213 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2214 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2215 IndexArrayOp -> mangle [mkM, mkP ] mkM
2216 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2217 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2219 NewMutVarOp -> mangle [mkM, mkP ] mkM
2220 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2221 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2222 SameMutVarOp -> mangle [mkP, mkP ] mkM
2224 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2225 mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM
2226 -- might use caught action multiply
2227 RaiseOp -> mangle [mkM ] mkM
2229 NewMVarOp -> mangle [mkP ] mkR
2230 TakeMVarOp -> mangle [mkM, mkP ] mkM
2231 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2232 SameMVarOp -> mangle [mkP, mkP ] mkM
2233 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2235 ForkOp -> mangle [mkO, mkP ] mkR
2236 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2238 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2239 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2240 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2242 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2243 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2244 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2245 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2246 EqStableNameOp -> mangle [mkP, mkP ] mkR
2247 StableNameToIntOp -> mangle [mkP ] mkR
2249 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2251 SeqOp -> mangle [mkO ] mkR
2252 ParOp -> mangle [mkO ] mkR
2253 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2254 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2255 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2256 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2257 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2258 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2259 CopyableOp -> mangle [mkZ ] mkR
2260 NoFollowOp -> mangle [mkZ ] mkR
2262 CCallOp _ -> mangle [ ] mkM
2264 -- Things with no Haskell pointers inside: in actuality, usages are
2265 -- irrelevant here (hence it doesn't matter that some of these
2266 -- apparently permit duplication; since such arguments are never
2267 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2268 -- except insofar as it propagates to infect other values that *are*
2271 otherwise -> nomangle
2273 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2274 mkO = mkUsgTy UsOnce -- pointed argument used once
2275 mkM = mkUsgTy UsMany -- pointed argument used multiply
2276 mkP = mkUsgTy UsOnce -- unpointed argument
2277 mkR = mkUsgTy UsMany -- unpointed result
2279 (tyvars, arg_tys, res_ty, _, _) = primOpSig op
2281 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2283 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2285 inFun f g ty = case splitFunTy_maybe ty of
2286 Just (a,b) -> mkFunTy (f a) (g b)
2287 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2289 inUB fs ty = case splitTyConApp_maybe ty of
2290 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
2291 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
2293 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2297 data PrimOpResultInfo
2298 = ReturnsPrim PrimRep
2301 -- Some PrimOps need not return a manifest primitive or algebraic value
2302 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2303 -- be out of line, or the code generator won't work.
2305 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2306 getPrimOpResultInfo (CCallOp _)
2307 = ReturnsAlg unboxedPairTyCon
2308 getPrimOpResultInfo op
2309 = case (primOpInfo op) of
2310 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2311 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2312 Compare _ ty -> ReturnsAlg boolTyCon
2313 GenPrimOp _ _ _ ty ->
2314 let rep = typePrimRep ty in
2316 PtrRep -> case splitAlgTyConApp_maybe ty of
2317 Nothing -> panic "getPrimOpResultInfo"
2318 Just (tc,_,_) -> ReturnsAlg tc
2319 other -> ReturnsPrim other
2322 The commutable ops are those for which we will try to move constants
2323 to the right hand side for strength reduction.
2326 commutableOp :: PrimOp -> Bool
2328 commutableOp CharEqOp = True
2329 commutableOp CharNeOp = True
2330 commutableOp IntAddOp = True
2331 commutableOp IntMulOp = True
2332 commutableOp AndOp = True
2333 commutableOp OrOp = True
2334 commutableOp XorOp = True
2335 commutableOp IntEqOp = True
2336 commutableOp IntNeOp = True
2337 commutableOp IntegerAddOp = True
2338 commutableOp IntegerMulOp = True
2339 commutableOp IntegerGcdOp = True
2340 commutableOp IntegerIntGcdOp = True
2341 commutableOp FloatAddOp = True
2342 commutableOp FloatMulOp = True
2343 commutableOp FloatEqOp = True
2344 commutableOp FloatNeOp = True
2345 commutableOp DoubleAddOp = True
2346 commutableOp DoubleMulOp = True
2347 commutableOp DoubleEqOp = True
2348 commutableOp DoubleNeOp = True
2349 commutableOp _ = False
2354 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2355 -- CharRep --> ([], Char#)
2356 -- StablePtrRep --> ([a], StablePtr# a)
2357 mkPrimTyApp tvs kind
2358 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2360 tycon = primRepTyCon kind
2361 forall_tvs = take (tyConArity tycon) tvs
2363 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2364 monadic_fun_ty ty = mkFunTy ty ty
2365 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2370 pprPrimOp :: PrimOp -> SDoc
2372 pprPrimOp (CCallOp c_call) = pprCCallOp c_call
2374 = getPprStyle $ \ sty ->
2375 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2376 ptext SLIT("PrelGHC.") <> pprOccName occ
2380 occ = primOpOcc other_op
2384 %************************************************************************
2386 \subsubsection{CCalls}
2388 %************************************************************************
2390 A special ``trap-door'' to use in making calls direct to C functions:
2394 Bool -- True <=> really a "casm"
2395 Bool -- True <=> might invoke Haskell GC
2396 CallConv -- calling convention to use.
2399 = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
2400 | DynamicTarget Unique -- First argument (an Addr#) is the function pointer
2401 -- (unique is used to generate a 'typedef' to cast
2402 -- the function pointer if compiling the ccall# down to
2403 -- .hc code - can't do this inline for tedious reasons.)
2405 ccallMayGC :: CCall -> Bool
2406 ccallMayGC (CCall _ _ may_gc _) = may_gc
2408 ccallIsCasm :: CCall -> Bool
2409 ccallIsCasm (CCall _ c_asm _ _) = c_asm
2413 pprCCallOp (CCall fun is_casm may_gc cconv)
2414 = hcat [ ifPprDebug callconv
2415 , text "__", ppr_dyn
2416 , text before , ppr_fun , after]
2418 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2421 | is_casm && may_gc = "casm_GC ``"
2422 | is_casm = "casm ``"
2423 | may_gc = "ccall_GC "
2424 | otherwise = "ccall "
2427 | is_casm = text "''"
2430 ppr_dyn = case fun of
2431 DynamicTarget _ -> text "dyn_"
2434 ppr_fun = case fun of
2435 DynamicTarget _ -> text "\"\""
2436 StaticTarget fn -> pprCLabelString fn