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, Boxity(..) )
46 import CStrings ( CLabelString, pprCLabelString )
47 import PrelNames ( 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
185 | BlockAsyncExceptionsOp
186 | UnblockAsyncExceptionsOp
209 -- Operation to test two closure addresses for equality (yes really!)
210 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
211 | ReallyUnsafePtrEqualityOp
226 -- more parallel stuff
227 | ParGlobalOp -- named global par
228 | ParLocalOp -- named local par
229 | ParAtOp -- specifies destination of local par
230 | ParAtAbsOp -- specifies destination of local par (abs processor)
231 | ParAtRelOp -- specifies destination of local par (rel processor)
232 | ParAtForNowOp -- specifies initial destination of global par
233 | CopyableOp -- marks copyable code
234 | NoFollowOp -- marks non-followup expression
241 Used for the Ord instance
244 primOpTag :: PrimOp -> Int
245 primOpTag op = IBOX( tagOf_PrimOp op )
247 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
248 tagOf_PrimOp CharGeOp = ILIT( 2)
249 tagOf_PrimOp CharEqOp = ILIT( 3)
250 tagOf_PrimOp CharNeOp = ILIT( 4)
251 tagOf_PrimOp CharLtOp = ILIT( 5)
252 tagOf_PrimOp CharLeOp = ILIT( 6)
253 tagOf_PrimOp IntGtOp = ILIT( 7)
254 tagOf_PrimOp IntGeOp = ILIT( 8)
255 tagOf_PrimOp IntEqOp = ILIT( 9)
256 tagOf_PrimOp IntNeOp = ILIT( 10)
257 tagOf_PrimOp IntLtOp = ILIT( 11)
258 tagOf_PrimOp IntLeOp = ILIT( 12)
259 tagOf_PrimOp WordGtOp = ILIT( 13)
260 tagOf_PrimOp WordGeOp = ILIT( 14)
261 tagOf_PrimOp WordEqOp = ILIT( 15)
262 tagOf_PrimOp WordNeOp = ILIT( 16)
263 tagOf_PrimOp WordLtOp = ILIT( 17)
264 tagOf_PrimOp WordLeOp = ILIT( 18)
265 tagOf_PrimOp AddrGtOp = ILIT( 19)
266 tagOf_PrimOp AddrGeOp = ILIT( 20)
267 tagOf_PrimOp AddrEqOp = ILIT( 21)
268 tagOf_PrimOp AddrNeOp = ILIT( 22)
269 tagOf_PrimOp AddrLtOp = ILIT( 23)
270 tagOf_PrimOp AddrLeOp = ILIT( 24)
271 tagOf_PrimOp FloatGtOp = ILIT( 25)
272 tagOf_PrimOp FloatGeOp = ILIT( 26)
273 tagOf_PrimOp FloatEqOp = ILIT( 27)
274 tagOf_PrimOp FloatNeOp = ILIT( 28)
275 tagOf_PrimOp FloatLtOp = ILIT( 29)
276 tagOf_PrimOp FloatLeOp = ILIT( 30)
277 tagOf_PrimOp DoubleGtOp = ILIT( 31)
278 tagOf_PrimOp DoubleGeOp = ILIT( 32)
279 tagOf_PrimOp DoubleEqOp = ILIT( 33)
280 tagOf_PrimOp DoubleNeOp = ILIT( 34)
281 tagOf_PrimOp DoubleLtOp = ILIT( 35)
282 tagOf_PrimOp DoubleLeOp = ILIT( 36)
283 tagOf_PrimOp OrdOp = ILIT( 37)
284 tagOf_PrimOp ChrOp = ILIT( 38)
285 tagOf_PrimOp IntAddOp = ILIT( 39)
286 tagOf_PrimOp IntSubOp = ILIT( 40)
287 tagOf_PrimOp IntMulOp = ILIT( 41)
288 tagOf_PrimOp IntQuotOp = ILIT( 42)
289 tagOf_PrimOp IntGcdOp = ILIT( 43)
290 tagOf_PrimOp IntRemOp = ILIT( 44)
291 tagOf_PrimOp IntNegOp = ILIT( 45)
292 tagOf_PrimOp WordQuotOp = ILIT( 47)
293 tagOf_PrimOp WordRemOp = ILIT( 48)
294 tagOf_PrimOp AndOp = ILIT( 49)
295 tagOf_PrimOp OrOp = ILIT( 50)
296 tagOf_PrimOp NotOp = ILIT( 51)
297 tagOf_PrimOp XorOp = ILIT( 52)
298 tagOf_PrimOp SllOp = ILIT( 53)
299 tagOf_PrimOp SrlOp = ILIT( 54)
300 tagOf_PrimOp ISllOp = ILIT( 55)
301 tagOf_PrimOp ISraOp = ILIT( 56)
302 tagOf_PrimOp ISrlOp = ILIT( 57)
303 tagOf_PrimOp IntAddCOp = ILIT( 58)
304 tagOf_PrimOp IntSubCOp = ILIT( 59)
305 tagOf_PrimOp IntMulCOp = ILIT( 60)
306 tagOf_PrimOp Int2WordOp = ILIT( 61)
307 tagOf_PrimOp Word2IntOp = ILIT( 62)
308 tagOf_PrimOp Int2AddrOp = ILIT( 63)
309 tagOf_PrimOp Addr2IntOp = ILIT( 64)
310 tagOf_PrimOp FloatAddOp = ILIT( 65)
311 tagOf_PrimOp FloatSubOp = ILIT( 66)
312 tagOf_PrimOp FloatMulOp = ILIT( 67)
313 tagOf_PrimOp FloatDivOp = ILIT( 68)
314 tagOf_PrimOp FloatNegOp = ILIT( 69)
315 tagOf_PrimOp Float2IntOp = ILIT( 70)
316 tagOf_PrimOp Int2FloatOp = ILIT( 71)
317 tagOf_PrimOp FloatExpOp = ILIT( 72)
318 tagOf_PrimOp FloatLogOp = ILIT( 73)
319 tagOf_PrimOp FloatSqrtOp = ILIT( 74)
320 tagOf_PrimOp FloatSinOp = ILIT( 75)
321 tagOf_PrimOp FloatCosOp = ILIT( 76)
322 tagOf_PrimOp FloatTanOp = ILIT( 77)
323 tagOf_PrimOp FloatAsinOp = ILIT( 78)
324 tagOf_PrimOp FloatAcosOp = ILIT( 79)
325 tagOf_PrimOp FloatAtanOp = ILIT( 80)
326 tagOf_PrimOp FloatSinhOp = ILIT( 81)
327 tagOf_PrimOp FloatCoshOp = ILIT( 82)
328 tagOf_PrimOp FloatTanhOp = ILIT( 83)
329 tagOf_PrimOp FloatPowerOp = ILIT( 84)
330 tagOf_PrimOp DoubleAddOp = ILIT( 85)
331 tagOf_PrimOp DoubleSubOp = ILIT( 86)
332 tagOf_PrimOp DoubleMulOp = ILIT( 87)
333 tagOf_PrimOp DoubleDivOp = ILIT( 88)
334 tagOf_PrimOp DoubleNegOp = ILIT( 89)
335 tagOf_PrimOp Double2IntOp = ILIT( 90)
336 tagOf_PrimOp Int2DoubleOp = ILIT( 91)
337 tagOf_PrimOp Double2FloatOp = ILIT( 92)
338 tagOf_PrimOp Float2DoubleOp = ILIT( 93)
339 tagOf_PrimOp DoubleExpOp = ILIT( 94)
340 tagOf_PrimOp DoubleLogOp = ILIT( 95)
341 tagOf_PrimOp DoubleSqrtOp = ILIT( 96)
342 tagOf_PrimOp DoubleSinOp = ILIT( 97)
343 tagOf_PrimOp DoubleCosOp = ILIT( 98)
344 tagOf_PrimOp DoubleTanOp = ILIT( 99)
345 tagOf_PrimOp DoubleAsinOp = ILIT(100)
346 tagOf_PrimOp DoubleAcosOp = ILIT(101)
347 tagOf_PrimOp DoubleAtanOp = ILIT(102)
348 tagOf_PrimOp DoubleSinhOp = ILIT(103)
349 tagOf_PrimOp DoubleCoshOp = ILIT(104)
350 tagOf_PrimOp DoubleTanhOp = ILIT(105)
351 tagOf_PrimOp DoublePowerOp = ILIT(106)
352 tagOf_PrimOp IntegerAddOp = ILIT(107)
353 tagOf_PrimOp IntegerSubOp = ILIT(108)
354 tagOf_PrimOp IntegerMulOp = ILIT(109)
355 tagOf_PrimOp IntegerGcdOp = ILIT(110)
356 tagOf_PrimOp IntegerIntGcdOp = ILIT(111)
357 tagOf_PrimOp IntegerDivExactOp = ILIT(112)
358 tagOf_PrimOp IntegerQuotOp = ILIT(113)
359 tagOf_PrimOp IntegerRemOp = ILIT(114)
360 tagOf_PrimOp IntegerQuotRemOp = ILIT(115)
361 tagOf_PrimOp IntegerDivModOp = ILIT(116)
362 tagOf_PrimOp IntegerNegOp = ILIT(117)
363 tagOf_PrimOp IntegerCmpOp = ILIT(118)
364 tagOf_PrimOp IntegerCmpIntOp = ILIT(119)
365 tagOf_PrimOp Integer2IntOp = ILIT(120)
366 tagOf_PrimOp Integer2WordOp = ILIT(121)
367 tagOf_PrimOp Int2IntegerOp = ILIT(122)
368 tagOf_PrimOp Word2IntegerOp = ILIT(123)
369 tagOf_PrimOp Addr2IntegerOp = ILIT(125)
370 tagOf_PrimOp IntegerToInt64Op = ILIT(127)
371 tagOf_PrimOp Int64ToIntegerOp = ILIT(128)
372 tagOf_PrimOp IntegerToWord64Op = ILIT(129)
373 tagOf_PrimOp Word64ToIntegerOp = ILIT(130)
374 tagOf_PrimOp FloatDecodeOp = ILIT(131)
375 tagOf_PrimOp DoubleDecodeOp = ILIT(132)
376 tagOf_PrimOp NewArrayOp = ILIT(133)
377 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(134)
378 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(135)
379 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(136)
380 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(137)
381 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(138)
382 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(139)
383 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(140)
384 tagOf_PrimOp SameMutableArrayOp = ILIT(141)
385 tagOf_PrimOp SameMutableByteArrayOp = ILIT(142)
386 tagOf_PrimOp ReadArrayOp = ILIT(143)
387 tagOf_PrimOp WriteArrayOp = ILIT(144)
388 tagOf_PrimOp IndexArrayOp = ILIT(145)
389 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(146)
390 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(147)
391 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(148)
392 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(149)
393 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(150)
394 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(151)
395 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(152)
396 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(153)
397 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(154)
398 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(155)
399 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(156)
400 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(157)
401 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(158)
402 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(159)
403 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(160)
404 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(161)
405 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(162)
406 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(163)
407 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(164)
408 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(165)
409 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(166)
410 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(167)
411 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(168)
412 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(169)
413 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(170)
414 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(171)
415 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(172)
416 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(173)
417 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(174)
418 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(175)
419 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(176)
420 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(177)
421 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(178)
422 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(179)
423 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(180)
424 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(181)
425 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(182)
426 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(183)
427 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(184)
428 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(185)
429 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(186)
430 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
431 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
432 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(189)
433 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
434 tagOf_PrimOp (ReadOffAddrOp CharRep) = ILIT(191)
435 tagOf_PrimOp (ReadOffAddrOp IntRep) = ILIT(192)
436 tagOf_PrimOp (ReadOffAddrOp WordRep) = ILIT(193)
437 tagOf_PrimOp (ReadOffAddrOp AddrRep) = ILIT(194)
438 tagOf_PrimOp (ReadOffAddrOp FloatRep) = ILIT(195)
439 tagOf_PrimOp (ReadOffAddrOp DoubleRep) = ILIT(196)
440 tagOf_PrimOp (ReadOffAddrOp StablePtrRep) = ILIT(197)
441 tagOf_PrimOp (ReadOffAddrOp ForeignObjRep) = ILIT(198)
442 tagOf_PrimOp (ReadOffAddrOp Int64Rep) = ILIT(199)
443 tagOf_PrimOp (ReadOffAddrOp Word64Rep) = ILIT(200)
444 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(201)
445 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(202)
446 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(203)
447 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(205)
448 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(206)
449 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(207)
450 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(208)
451 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(209)
452 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(210)
453 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(211)
454 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(212)
455 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(213)
456 tagOf_PrimOp UnsafeThawArrayOp = ILIT(214)
457 tagOf_PrimOp SizeofByteArrayOp = ILIT(215)
458 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(216)
459 tagOf_PrimOp NewMVarOp = ILIT(217)
460 tagOf_PrimOp TakeMVarOp = ILIT(218)
461 tagOf_PrimOp PutMVarOp = ILIT(219)
462 tagOf_PrimOp SameMVarOp = ILIT(220)
463 tagOf_PrimOp TryTakeMVarOp = ILIT(221)
464 tagOf_PrimOp IsEmptyMVarOp = ILIT(222)
465 tagOf_PrimOp MkForeignObjOp = ILIT(223)
466 tagOf_PrimOp WriteForeignObjOp = ILIT(224)
467 tagOf_PrimOp MkWeakOp = ILIT(225)
468 tagOf_PrimOp DeRefWeakOp = ILIT(226)
469 tagOf_PrimOp FinalizeWeakOp = ILIT(227)
470 tagOf_PrimOp MakeStableNameOp = ILIT(228)
471 tagOf_PrimOp EqStableNameOp = ILIT(229)
472 tagOf_PrimOp StableNameToIntOp = ILIT(230)
473 tagOf_PrimOp MakeStablePtrOp = ILIT(231)
474 tagOf_PrimOp DeRefStablePtrOp = ILIT(232)
475 tagOf_PrimOp EqStablePtrOp = ILIT(234)
476 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(235)
477 tagOf_PrimOp SeqOp = ILIT(236)
478 tagOf_PrimOp ParOp = ILIT(237)
479 tagOf_PrimOp ForkOp = ILIT(238)
480 tagOf_PrimOp KillThreadOp = ILIT(239)
481 tagOf_PrimOp YieldOp = ILIT(240)
482 tagOf_PrimOp MyThreadIdOp = ILIT(241)
483 tagOf_PrimOp DelayOp = ILIT(242)
484 tagOf_PrimOp WaitReadOp = ILIT(243)
485 tagOf_PrimOp WaitWriteOp = ILIT(244)
486 tagOf_PrimOp ParGlobalOp = ILIT(245)
487 tagOf_PrimOp ParLocalOp = ILIT(246)
488 tagOf_PrimOp ParAtOp = ILIT(247)
489 tagOf_PrimOp ParAtAbsOp = ILIT(248)
490 tagOf_PrimOp ParAtRelOp = ILIT(249)
491 tagOf_PrimOp ParAtForNowOp = ILIT(250)
492 tagOf_PrimOp CopyableOp = ILIT(251)
493 tagOf_PrimOp NoFollowOp = ILIT(252)
494 tagOf_PrimOp NewMutVarOp = ILIT(253)
495 tagOf_PrimOp ReadMutVarOp = ILIT(254)
496 tagOf_PrimOp WriteMutVarOp = ILIT(255)
497 tagOf_PrimOp SameMutVarOp = ILIT(256)
498 tagOf_PrimOp CatchOp = ILIT(257)
499 tagOf_PrimOp RaiseOp = ILIT(258)
500 tagOf_PrimOp BlockAsyncExceptionsOp = ILIT(259)
501 tagOf_PrimOp UnblockAsyncExceptionsOp = ILIT(260)
502 tagOf_PrimOp DataToTagOp = ILIT(261)
503 tagOf_PrimOp TagToEnumOp = ILIT(262)
505 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
507 instance Eq PrimOp where
508 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
510 instance Ord PrimOp where
511 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
512 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
513 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
514 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
515 op1 `compare` op2 | op1 < op2 = LT
519 instance Outputable PrimOp where
520 ppr op = pprPrimOp op
522 instance Show PrimOp where
523 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
526 An @Enum@-derived list would be better; meanwhile... (ToDo)
528 allThePrimOps -- Except CCall, which is really a family of primops
660 NewByteArrayOp CharRep,
661 NewByteArrayOp IntRep,
662 NewByteArrayOp WordRep,
663 NewByteArrayOp AddrRep,
664 NewByteArrayOp FloatRep,
665 NewByteArrayOp DoubleRep,
666 NewByteArrayOp StablePtrRep,
668 SameMutableByteArrayOp,
672 ReadByteArrayOp CharRep,
673 ReadByteArrayOp IntRep,
674 ReadByteArrayOp WordRep,
675 ReadByteArrayOp AddrRep,
676 ReadByteArrayOp FloatRep,
677 ReadByteArrayOp DoubleRep,
678 ReadByteArrayOp StablePtrRep,
679 ReadByteArrayOp Int64Rep,
680 ReadByteArrayOp Word64Rep,
681 WriteByteArrayOp CharRep,
682 WriteByteArrayOp IntRep,
683 WriteByteArrayOp WordRep,
684 WriteByteArrayOp AddrRep,
685 WriteByteArrayOp FloatRep,
686 WriteByteArrayOp DoubleRep,
687 WriteByteArrayOp StablePtrRep,
688 WriteByteArrayOp Int64Rep,
689 WriteByteArrayOp Word64Rep,
690 IndexByteArrayOp CharRep,
691 IndexByteArrayOp IntRep,
692 IndexByteArrayOp WordRep,
693 IndexByteArrayOp AddrRep,
694 IndexByteArrayOp FloatRep,
695 IndexByteArrayOp DoubleRep,
696 IndexByteArrayOp StablePtrRep,
697 IndexByteArrayOp Int64Rep,
698 IndexByteArrayOp Word64Rep,
699 IndexOffForeignObjOp CharRep,
700 IndexOffForeignObjOp AddrRep,
701 IndexOffForeignObjOp IntRep,
702 IndexOffForeignObjOp WordRep,
703 IndexOffForeignObjOp FloatRep,
704 IndexOffForeignObjOp DoubleRep,
705 IndexOffForeignObjOp StablePtrRep,
706 IndexOffForeignObjOp Int64Rep,
707 IndexOffForeignObjOp Word64Rep,
708 IndexOffAddrOp CharRep,
709 IndexOffAddrOp IntRep,
710 IndexOffAddrOp WordRep,
711 IndexOffAddrOp AddrRep,
712 IndexOffAddrOp FloatRep,
713 IndexOffAddrOp DoubleRep,
714 IndexOffAddrOp StablePtrRep,
715 IndexOffAddrOp Int64Rep,
716 IndexOffAddrOp Word64Rep,
717 ReadOffAddrOp CharRep,
718 ReadOffAddrOp IntRep,
719 ReadOffAddrOp WordRep,
720 ReadOffAddrOp AddrRep,
721 ReadOffAddrOp FloatRep,
722 ReadOffAddrOp DoubleRep,
723 ReadOffAddrOp ForeignObjRep,
724 ReadOffAddrOp StablePtrRep,
725 ReadOffAddrOp Int64Rep,
726 ReadOffAddrOp Word64Rep,
727 WriteOffAddrOp CharRep,
728 WriteOffAddrOp IntRep,
729 WriteOffAddrOp WordRep,
730 WriteOffAddrOp AddrRep,
731 WriteOffAddrOp FloatRep,
732 WriteOffAddrOp DoubleRep,
733 WriteOffAddrOp ForeignObjRep,
734 WriteOffAddrOp StablePtrRep,
735 WriteOffAddrOp Int64Rep,
736 WriteOffAddrOp Word64Rep,
738 UnsafeFreezeByteArrayOp,
741 SizeofMutableByteArrayOp,
748 BlockAsyncExceptionsOp,
749 UnblockAsyncExceptionsOp,
767 ReallyUnsafePtrEqualityOp,
790 %************************************************************************
792 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
794 %************************************************************************
796 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
797 refer to the primitive operation. The conventional \tr{#}-for-
798 unboxed ops is added on later.
800 The reason for the funny characters in the names is so we do not
801 interfere with the programmer's Haskell name spaces.
803 We use @PrimKinds@ for the ``type'' information, because they're
804 (slightly) more convenient to use than @TyCons@.
807 = Dyadic OccName -- string :: T -> T -> T
809 | Monadic OccName -- string :: T -> T
811 | Compare OccName -- string :: T -> T -> Bool
814 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
819 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
820 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
821 mkCompare str ty = Compare (mkSrcVarOcc str) ty
822 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
827 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
829 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
830 intPrimTy, byteArrayPrimTy] -- second '' pieces
831 an_Integer_and_Int_tys
832 = [intPrimTy, byteArrayPrimTy, -- Integer
835 unboxedSingleton = mkTupleTy Unboxed 1
836 unboxedPair = mkTupleTy Unboxed 2
837 unboxedTriple = mkTupleTy Unboxed 3
838 unboxedQuadruple = mkTupleTy Unboxed 4
840 mkIOTy ty = mkFunTy realWorldStatePrimTy
841 (unboxedPair [realWorldStatePrimTy,ty])
843 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
844 (unboxedPair one_Integer_ty)
846 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
847 (unboxedPair one_Integer_ty)
849 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
850 (unboxedQuadruple two_Integer_tys)
852 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
855 %************************************************************************
857 \subsubsection{Strictness}
859 %************************************************************************
861 Not all primops are strict!
864 primOpStrictness :: Arity -> PrimOp -> StrictnessInfo
865 -- See Demand.StrictnessInfo for discussion of what the results
866 -- The arity should be the arity of the primop; that's why
867 -- this function isn't exported.
869 primOpStrictness arity SeqOp = StrictnessInfo [wwStrict] False
870 -- Seq is strict in its argument; see notes in ConFold.lhs
872 primOpStrictness arity ParOp = StrictnessInfo [wwLazy] False
873 -- Note that Par is lazy to avoid that the sparked thing
874 -- gets evaluted strictly, which it should *not* be
876 primOpStrictness arity ForkOp = StrictnessInfo [wwLazy, wwPrim] False
878 primOpStrictness arity NewArrayOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
879 primOpStrictness arity WriteArrayOp = StrictnessInfo [wwPrim, wwPrim, wwLazy, wwPrim] False
881 primOpStrictness arity NewMutVarOp = StrictnessInfo [wwLazy, wwPrim] False
882 primOpStrictness arity WriteMutVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
884 primOpStrictness arity PutMVarOp = StrictnessInfo [wwPrim, wwLazy, wwPrim] False
886 primOpStrictness arity CatchOp = StrictnessInfo [wwLazy, wwLazy, wwPrim] False
887 -- Catch is actually strict in its first argument
888 -- but we don't want to tell the strictness
889 -- analyser about that!
891 primOpStrictness arity RaiseOp = StrictnessInfo [wwLazy] True -- NB: True => result is bottom
892 primOpStrictness arity BlockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
893 primOpStrictness arity UnblockAsyncExceptionsOp = StrictnessInfo [wwLazy] False
895 primOpStrictness arity MkWeakOp = StrictnessInfo [wwLazy, wwLazy, wwLazy, wwPrim] False
896 primOpStrictness arity MakeStableNameOp = StrictnessInfo [wwLazy, wwPrim] False
897 primOpStrictness arity MakeStablePtrOp = StrictnessInfo [wwLazy, wwPrim] False
899 primOpStrictness arity DataToTagOp = StrictnessInfo [wwLazy] False
901 -- The rest all have primitive-typed arguments
902 primOpStrictness arity other = StrictnessInfo (replicate arity wwPrim) False
905 %************************************************************************
907 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
909 %************************************************************************
911 @primOpInfo@ gives all essential information (from which everything
912 else, notably a type, can be constructed) for each @PrimOp@.
915 primOpInfo :: PrimOp -> PrimOpInfo
918 There's plenty of this stuff!
921 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
922 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
923 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
924 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
925 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
926 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
928 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
929 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
930 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
931 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
932 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
933 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
935 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
936 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
937 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
938 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
939 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
940 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
942 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
943 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
944 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
945 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
946 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
947 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
949 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
950 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
951 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
952 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
953 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
954 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
956 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
957 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
958 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
959 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
960 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
961 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
965 %************************************************************************
967 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
969 %************************************************************************
972 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
973 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
976 %************************************************************************
978 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
980 %************************************************************************
983 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
984 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
985 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
986 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
987 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
988 primOpInfo IntGcdOp = mkDyadic SLIT("gcdInt#") intPrimTy
990 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
992 primOpInfo IntAddCOp =
993 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
994 (unboxedPair [intPrimTy, intPrimTy])
996 primOpInfo IntSubCOp =
997 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
998 (unboxedPair [intPrimTy, intPrimTy])
1000 primOpInfo IntMulCOp =
1001 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
1002 (unboxedPair [intPrimTy, intPrimTy])
1005 %************************************************************************
1007 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
1009 %************************************************************************
1011 A @Word#@ is an unsigned @Int#@.
1014 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
1015 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
1017 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
1018 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
1019 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
1020 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
1023 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1025 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
1028 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
1030 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
1032 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
1034 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
1035 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
1038 %************************************************************************
1040 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
1042 %************************************************************************
1045 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
1046 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
1050 %************************************************************************
1052 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
1054 %************************************************************************
1056 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
1059 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
1060 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
1061 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
1062 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
1063 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
1065 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
1066 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
1068 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
1069 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
1070 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
1071 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
1072 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
1073 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1074 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1075 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1076 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1077 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1078 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1079 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1080 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1083 %************************************************************************
1085 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1087 %************************************************************************
1089 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
1092 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1093 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1094 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1095 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1096 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1098 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1099 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1101 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1102 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1104 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1105 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1106 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1107 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1108 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1109 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1110 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1111 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1112 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1113 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1114 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1115 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1116 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1119 %************************************************************************
1121 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1123 %************************************************************************
1126 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1128 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1129 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1130 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1131 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1132 primOpInfo IntegerIntGcdOp = mkGenPrimOp SLIT("gcdIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1133 primOpInfo IntegerDivExactOp = integerDyadic SLIT("divExactInteger#")
1134 primOpInfo IntegerQuotOp = integerDyadic SLIT("quotInteger#")
1135 primOpInfo IntegerRemOp = integerDyadic SLIT("remInteger#")
1137 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1138 primOpInfo IntegerCmpIntOp
1139 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
1141 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1142 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1144 primOpInfo Integer2IntOp
1145 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1147 primOpInfo Integer2WordOp
1148 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1150 primOpInfo Int2IntegerOp
1151 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1152 (unboxedPair one_Integer_ty)
1154 primOpInfo Word2IntegerOp
1155 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1156 (unboxedPair one_Integer_ty)
1158 primOpInfo Addr2IntegerOp
1159 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1160 (unboxedPair one_Integer_ty)
1162 primOpInfo IntegerToInt64Op
1163 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1165 primOpInfo Int64ToIntegerOp
1166 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1167 (unboxedPair one_Integer_ty)
1169 primOpInfo Word64ToIntegerOp
1170 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1171 (unboxedPair one_Integer_ty)
1173 primOpInfo IntegerToWord64Op
1174 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1177 Decoding of floating-point numbers is sorta Integer-related. Encoding
1178 is done with plain ccalls now (see PrelNumExtra.lhs).
1181 primOpInfo FloatDecodeOp
1182 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1183 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1184 primOpInfo DoubleDecodeOp
1185 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1186 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1189 %************************************************************************
1191 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1193 %************************************************************************
1196 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
1197 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
1201 primOpInfo NewArrayOp
1203 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1204 state = mkStatePrimTy s
1206 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1207 [intPrimTy, elt, state]
1208 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1210 primOpInfo (NewByteArrayOp kind)
1212 s = alphaTy; s_tv = alphaTyVar
1214 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1215 state = mkStatePrimTy s
1217 mkGenPrimOp op_str [s_tv]
1219 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1221 ---------------------------------------------------------------------------
1224 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
1225 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
1228 primOpInfo SameMutableArrayOp
1230 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1231 mut_arr_ty = mkMutableArrayPrimTy s elt
1233 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1236 primOpInfo SameMutableByteArrayOp
1238 s = alphaTy; s_tv = alphaTyVar;
1239 mut_arr_ty = mkMutableByteArrayPrimTy s
1241 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1244 ---------------------------------------------------------------------------
1245 -- Primitive arrays of Haskell pointers:
1248 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
1249 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
1250 indexArray# :: Array# a -> Int# -> (# a #)
1253 primOpInfo ReadArrayOp
1255 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1256 state = mkStatePrimTy s
1258 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1259 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1260 (unboxedPair [state, elt])
1263 primOpInfo WriteArrayOp
1265 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1267 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1268 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1271 primOpInfo IndexArrayOp
1272 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1273 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1274 (unboxedSingleton [elt])
1276 ---------------------------------------------------------------------------
1277 -- Primitive arrays full of unboxed bytes:
1279 primOpInfo (ReadByteArrayOp kind)
1281 s = alphaTy; s_tv = alphaTyVar
1283 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1284 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1285 state = mkStatePrimTy s
1287 mkGenPrimOp op_str (s_tv:tvs)
1288 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1289 (unboxedPair [state, prim_ty])
1291 primOpInfo (WriteByteArrayOp kind)
1293 s = alphaTy; s_tv = alphaTyVar
1294 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1295 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1297 mkGenPrimOp op_str (s_tv:tvs)
1298 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1301 primOpInfo (IndexByteArrayOp kind)
1303 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1304 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1306 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
1308 primOpInfo (IndexOffForeignObjOp kind)
1310 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1311 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1313 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
1315 primOpInfo (IndexOffAddrOp kind)
1317 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1318 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
1320 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
1322 primOpInfo (ReadOffAddrOp kind)
1324 s = alphaTy; s_tv = alphaTyVar
1325 op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#")
1326 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1327 state = mkStatePrimTy s
1329 mkGenPrimOp op_str (s_tv:tvs)
1330 [addrPrimTy, intPrimTy, state]
1331 (unboxedPair [state, prim_ty])
1333 primOpInfo (WriteOffAddrOp kind)
1335 s = alphaTy; s_tv = alphaTyVar
1336 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1337 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
1339 mkGenPrimOp op_str (s_tv:tvs)
1340 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1343 ---------------------------------------------------------------------------
1345 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
1346 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
1347 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
1350 primOpInfo UnsafeFreezeArrayOp
1352 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1353 state = mkStatePrimTy s
1355 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1356 [mkMutableArrayPrimTy s elt, state]
1357 (unboxedPair [state, mkArrayPrimTy elt])
1359 primOpInfo UnsafeFreezeByteArrayOp
1361 s = alphaTy; s_tv = alphaTyVar;
1362 state = mkStatePrimTy s
1364 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1365 [mkMutableByteArrayPrimTy s, state]
1366 (unboxedPair [state, byteArrayPrimTy])
1368 primOpInfo UnsafeThawArrayOp
1370 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1371 state = mkStatePrimTy s
1373 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
1374 [mkArrayPrimTy elt, state]
1375 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1377 ---------------------------------------------------------------------------
1378 primOpInfo SizeofByteArrayOp
1380 SLIT("sizeofByteArray#") []
1384 primOpInfo SizeofMutableByteArrayOp
1385 = let { s = alphaTy; s_tv = alphaTyVar } in
1387 SLIT("sizeofMutableByteArray#") [s_tv]
1388 [mkMutableByteArrayPrimTy s]
1393 %************************************************************************
1395 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1397 %************************************************************************
1400 primOpInfo NewMutVarOp
1402 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1403 state = mkStatePrimTy s
1405 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1407 (unboxedPair [state, mkMutVarPrimTy s elt])
1409 primOpInfo ReadMutVarOp
1411 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1412 state = mkStatePrimTy s
1414 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1415 [mkMutVarPrimTy s elt, state]
1416 (unboxedPair [state, elt])
1419 primOpInfo WriteMutVarOp
1421 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1423 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1424 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1427 primOpInfo SameMutVarOp
1429 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1430 mut_var_ty = mkMutVarPrimTy s elt
1432 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1436 %************************************************************************
1438 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1440 %************************************************************************
1442 catch# :: (State# RealWorld -> (# State# RealWorld, a))
1443 -> (b -> State# RealWorld -> (# State# RealWorld, a))
1445 -> (# State# RealWorld, a)
1447 throw :: Exception -> a
1450 blockAsyncExceptions# :: IO a -> IO a
1451 unblockAsyncExceptions# :: IO a -> IO a
1456 a = alphaTy; a_tv = alphaTyVar
1457 b = betaTy; b_tv = betaTyVar;
1460 mkGenPrimOp SLIT("catch#") [a_tv, b_tv]
1461 [io_a, mkFunTy b io_a, realWorldStatePrimTy]
1462 (unboxedPair [realWorldStatePrimTy, a])
1466 a = alphaTy; a_tv = alphaTyVar
1467 b = betaTy; b_tv = betaTyVar;
1469 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1471 primOpInfo BlockAsyncExceptionsOp
1473 a = alphaTy; a_tv = alphaTyVar
1475 mkGenPrimOp SLIT("blockAsyncExceptions#") [a_tv]
1476 [ mkIOTy a, realWorldStatePrimTy ]
1477 (unboxedPair [realWorldStatePrimTy,a])
1479 primOpInfo UnblockAsyncExceptionsOp
1481 a = alphaTy; a_tv = alphaTyVar
1483 mkGenPrimOp SLIT("unblockAsyncExceptions#") [a_tv]
1484 [ mkIOTy a, realWorldStatePrimTy ]
1485 (unboxedPair [realWorldStatePrimTy,a])
1488 %************************************************************************
1490 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1492 %************************************************************************
1495 primOpInfo NewMVarOp
1497 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1498 state = mkStatePrimTy s
1500 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1501 (unboxedPair [state, mkMVarPrimTy s elt])
1503 primOpInfo TakeMVarOp
1505 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1506 state = mkStatePrimTy s
1508 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1509 [mkMVarPrimTy s elt, state]
1510 (unboxedPair [state, elt])
1512 primOpInfo PutMVarOp
1514 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1516 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1517 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1520 primOpInfo SameMVarOp
1522 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1523 mvar_ty = mkMVarPrimTy s elt
1525 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1527 primOpInfo TryTakeMVarOp
1529 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1530 state = mkStatePrimTy s
1532 mkGenPrimOp SLIT("tryTakeMVar#") [s_tv, elt_tv]
1533 [mkMVarPrimTy s elt, state]
1534 (unboxedTriple [state, intPrimTy, elt])
1536 primOpInfo IsEmptyMVarOp
1538 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1539 state = mkStatePrimTy s
1541 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
1542 [mkMVarPrimTy s elt, mkStatePrimTy s]
1543 (unboxedPair [state, intPrimTy])
1547 %************************************************************************
1549 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1551 %************************************************************************
1557 s = alphaTy; s_tv = alphaTyVar
1559 mkGenPrimOp SLIT("delay#") [s_tv]
1560 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1562 primOpInfo WaitReadOp
1564 s = alphaTy; s_tv = alphaTyVar
1566 mkGenPrimOp SLIT("waitRead#") [s_tv]
1567 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1569 primOpInfo WaitWriteOp
1571 s = alphaTy; s_tv = alphaTyVar
1573 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1574 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1577 %************************************************************************
1579 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1581 %************************************************************************
1584 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1586 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1587 [alphaTy, realWorldStatePrimTy]
1588 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1590 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
1591 primOpInfo KillThreadOp
1592 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
1593 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
1594 realWorldStatePrimTy
1596 -- yield# :: State# RealWorld -> State# RealWorld
1598 = mkGenPrimOp SLIT("yield#") []
1599 [realWorldStatePrimTy]
1600 realWorldStatePrimTy
1602 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
1603 primOpInfo MyThreadIdOp
1604 = mkGenPrimOp SLIT("myThreadId#") []
1605 [realWorldStatePrimTy]
1606 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1609 ************************************************************************
1611 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1613 %************************************************************************
1616 primOpInfo MkForeignObjOp
1617 = mkGenPrimOp SLIT("mkForeignObj#") []
1618 [addrPrimTy, realWorldStatePrimTy]
1619 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1621 primOpInfo WriteForeignObjOp
1623 s = alphaTy; s_tv = alphaTyVar
1625 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1626 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1629 ************************************************************************
1631 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1633 %************************************************************************
1635 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1637 mkWeak# :: k -> v -> f -> State# RealWorld
1638 -> (# State# RealWorld, Weak# v #)
1640 In practice, you'll use the higher-level
1642 data Weak v = Weak# v
1643 mkWeak :: k -> v -> IO () -> IO (Weak v)
1647 = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
1648 [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
1649 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1652 The following operation dereferences a weak pointer. The weak pointer
1653 may have been finalized, so the operation returns a result code which
1654 must be inspected before looking at the dereferenced value.
1656 deRefWeak# :: Weak# v -> State# RealWorld ->
1657 (# State# RealWorld, v, Int# #)
1659 Only look at v if the Int# returned is /= 0 !!
1661 The higher-level op is
1663 deRefWeak :: Weak v -> IO (Maybe v)
1666 primOpInfo DeRefWeakOp
1667 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1668 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1669 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1672 Weak pointers can be finalized early by using the finalize# operation:
1674 finalizeWeak# :: Weak# v -> State# RealWorld ->
1675 (# State# RealWorld, Int#, IO () #)
1677 The Int# returned is either
1679 0 if the weak pointer has already been finalized, or it has no
1680 finalizer (the third component is then invalid).
1682 1 if the weak pointer is still alive, with the finalizer returned
1683 as the third component.
1686 primOpInfo FinalizeWeakOp
1687 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
1688 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1689 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
1690 mkFunTy realWorldStatePrimTy
1691 (unboxedPair [realWorldStatePrimTy,unitTy])])
1694 %************************************************************************
1696 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
1698 %************************************************************************
1700 A {\em stable name/pointer} is an index into a table of stable name
1701 entries. Since the garbage collector is told about stable pointers,
1702 it is safe to pass a stable pointer to external systems such as C
1706 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
1707 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
1708 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
1709 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1712 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
1713 operation since it doesn't (directly) involve IO operations. The
1714 reason is that if some optimisation pass decided to duplicate calls to
1715 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1716 massive space leak can result. Putting it into the IO monad
1717 prevents this. (Another reason for putting them in a monad is to
1718 ensure correct sequencing wrt the side-effecting @freeStablePtr@
1721 An important property of stable pointers is that if you call
1722 makeStablePtr# twice on the same object you get the same stable
1725 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1726 besides, it's not likely to be used from Haskell) so it's not a
1729 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1734 A stable name is like a stable pointer, but with three important differences:
1736 (a) You can't deRef one to get back to the original object.
1737 (b) You can convert one to an Int.
1738 (c) You don't need to 'freeStableName'
1740 The existence of a stable name doesn't guarantee to keep the object it
1741 points to alive (unlike a stable pointer), hence (a).
1745 (a) makeStableName always returns the same value for a given
1746 object (same as stable pointers).
1748 (b) if two stable names are equal, it implies that the objects
1749 from which they were created were the same.
1751 (c) stableNameToInt always returns the same Int for a given
1755 primOpInfo MakeStablePtrOp
1756 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1757 [alphaTy, realWorldStatePrimTy]
1758 (unboxedPair [realWorldStatePrimTy,
1759 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1761 primOpInfo DeRefStablePtrOp
1762 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1763 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1764 (unboxedPair [realWorldStatePrimTy, alphaTy])
1766 primOpInfo EqStablePtrOp
1767 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1768 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1771 primOpInfo MakeStableNameOp
1772 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
1773 [alphaTy, realWorldStatePrimTy]
1774 (unboxedPair [realWorldStatePrimTy,
1775 mkTyConApp stableNamePrimTyCon [alphaTy]])
1777 primOpInfo EqStableNameOp
1778 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
1779 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
1782 primOpInfo StableNameToIntOp
1783 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
1784 [mkStableNamePrimTy alphaTy]
1788 %************************************************************************
1790 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1792 %************************************************************************
1794 [Alastair Reid is to blame for this!]
1796 These days, (Glasgow) Haskell seems to have a bit of everything from
1797 other languages: strict operations, mutable variables, sequencing,
1798 pointers, etc. About the only thing left is LISP's ability to test
1799 for pointer equality. So, let's add it in!
1802 reallyUnsafePtrEquality :: a -> a -> Int#
1805 which tests any two closures (of the same type) to see if they're the
1806 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1807 difficulties of trying to box up the result.)
1809 NB This is {\em really unsafe\/} because even something as trivial as
1810 a garbage collection might change the answer by removing indirections.
1811 Still, no-one's forcing you to use it. If you're worried about little
1812 things like loss of referential transparency, you might like to wrap
1813 it all up in a monad-like thing as John O'Donnell and John Hughes did
1814 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1817 I'm thinking of using it to speed up a critical equality test in some
1818 graphics stuff in a context where the possibility of saying that
1819 denotationally equal things aren't isn't a problem (as long as it
1820 doesn't happen too often.) ADR
1822 To Will: Jim said this was already in, but I can't see it so I'm
1823 adding it. Up to you whether you add it. (Note that this could have
1824 been readily implemented using a @veryDangerousCCall@ before they were
1828 primOpInfo ReallyUnsafePtrEqualityOp
1829 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1830 [alphaTy, alphaTy] intPrimTy
1833 %************************************************************************
1835 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1837 %************************************************************************
1840 primOpInfo SeqOp -- seq# :: a -> Int#
1841 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1843 primOpInfo ParOp -- par# :: a -> Int#
1844 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1848 -- HWL: The first 4 Int# in all par... annotations denote:
1849 -- name, granularity info, size of result, degree of parallelism
1850 -- Same structure as _seq_ i.e. returns Int#
1851 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
1852 -- `the processor containing the expression v'; it is not evaluated
1854 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1855 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1857 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1858 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1860 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1861 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1863 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1864 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1866 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1867 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1869 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
1870 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1872 primOpInfo CopyableOp -- copyable# :: a -> Int#
1873 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1875 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
1876 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1879 %************************************************************************
1881 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
1883 %************************************************************************
1885 These primops are pretty wierd.
1887 dataToTag# :: a -> Int (arg must be an evaluated data type)
1888 tagToEnum# :: Int -> a (result type must be an enumerated type)
1890 The constraints aren't currently checked by the front end, but the
1891 code generator will fall over if they aren't satisfied.
1894 primOpInfo DataToTagOp
1895 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
1897 primOpInfo TagToEnumOp
1898 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
1901 primOpInfo op = pprPanic "primOpInfo:" (ppr op)
1905 %************************************************************************
1907 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
1909 %************************************************************************
1911 Some PrimOps need to be called out-of-line because they either need to
1912 perform a heap check or they block.
1918 TryTakeMVarOp -> True
1925 BlockAsyncExceptionsOp -> True
1926 UnblockAsyncExceptionsOp -> True
1928 NewByteArrayOp _ -> True
1929 IntegerAddOp -> True
1930 IntegerSubOp -> True
1931 IntegerMulOp -> True
1932 IntegerGcdOp -> True
1933 IntegerDivExactOp -> True
1934 IntegerQuotOp -> True
1935 IntegerRemOp -> True
1936 IntegerQuotRemOp -> True
1937 IntegerDivModOp -> True
1938 Int2IntegerOp -> True
1939 Word2IntegerOp -> True
1940 Addr2IntegerOp -> True
1941 Word64ToIntegerOp -> True
1942 Int64ToIntegerOp -> True
1943 FloatDecodeOp -> True
1944 DoubleDecodeOp -> True
1946 FinalizeWeakOp -> True
1947 MakeStableNameOp -> True
1948 MkForeignObjOp -> True
1952 KillThreadOp -> True
1955 UnsafeThawArrayOp -> True
1956 -- UnsafeThawArrayOp doesn't perform any heap checks,
1957 -- but it is of such an esoteric nature that
1958 -- it is done out-of-line rather than require
1959 -- the NCG to implement it.
1961 CCallOp c_call -> ccallMayGC c_call
1967 primOpOkForSpeculation
1968 ~~~~~~~~~~~~~~~~~~~~~~
1969 Sometimes we may choose to execute a PrimOp even though it isn't
1970 certain that its result will be required; ie execute them
1971 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1972 this is OK, because PrimOps are usually cheap, but it isn't OK for
1973 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1975 PrimOps that have side effects also should not be executed speculatively.
1977 Ok-for-speculation also means that it's ok *not* to execute the
1981 Here the result is not used, so we can discard the primop. Anything
1982 that has side effects mustn't be dicarded in this way, of course!
1984 See also @primOpIsCheap@ (below).
1988 primOpOkForSpeculation :: PrimOp -> Bool
1989 -- See comments with CoreUtils.exprOkForSpeculation
1990 primOpOkForSpeculation op
1991 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1997 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1998 WARNING), we just borrow some other predicates for a
1999 what-should-be-good-enough test. "Cheap" means willing to call it more
2000 than once. Evaluation order is unaffected.
2003 primOpIsCheap :: PrimOp -> Bool
2004 -- See comments with CoreUtils.exprOkForSpeculation
2005 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
2010 primOpIsDupable means that the use of the primop is small enough to
2011 duplicate into different case branches. See CoreUtils.exprIsDupable.
2014 primOpIsDupable :: PrimOp -> Bool
2015 -- See comments with CoreUtils.exprIsDupable
2016 -- We say it's dupable it isn't implemented by a C call with a wrapper
2017 primOpIsDupable op = not (primOpNeedsWrapper op)
2022 primOpCanFail :: PrimOp -> Bool
2024 primOpCanFail IntQuotOp = True -- Divide by zero
2025 primOpCanFail IntRemOp = True -- Divide by zero
2028 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
2029 primOpCanFail IntegerDivModOp = True -- Divide by zero
2031 -- Float. ToDo: tan? tanh?
2032 primOpCanFail FloatDivOp = True -- Divide by zero
2033 primOpCanFail FloatLogOp = True -- Log of zero
2034 primOpCanFail FloatAsinOp = True -- Arg out of domain
2035 primOpCanFail FloatAcosOp = True -- Arg out of domain
2037 -- Double. ToDo: tan? tanh?
2038 primOpCanFail DoubleDivOp = True -- Divide by zero
2039 primOpCanFail DoubleLogOp = True -- Log of zero
2040 primOpCanFail DoubleAsinOp = True -- Arg out of domain
2041 primOpCanFail DoubleAcosOp = True -- Arg out of domain
2043 primOpCanFail other_op = False
2046 And some primops have side-effects and so, for example, must not be
2050 primOpHasSideEffects :: PrimOp -> Bool
2052 primOpHasSideEffects ParOp = True
2053 primOpHasSideEffects ForkOp = True
2054 primOpHasSideEffects KillThreadOp = True
2055 primOpHasSideEffects YieldOp = True
2056 primOpHasSideEffects SeqOp = True
2058 primOpHasSideEffects MkForeignObjOp = True
2059 primOpHasSideEffects WriteForeignObjOp = True
2060 primOpHasSideEffects MkWeakOp = True
2061 primOpHasSideEffects DeRefWeakOp = True
2062 primOpHasSideEffects FinalizeWeakOp = True
2063 primOpHasSideEffects MakeStablePtrOp = True
2064 primOpHasSideEffects MakeStableNameOp = True
2065 primOpHasSideEffects EqStablePtrOp = True -- SOF
2066 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
2068 -- In general, writes are considered a side effect, but
2069 -- reads and variable allocations are not
2070 -- Why? Because writes must not be omitted, but reads can be if their result is not used.
2071 -- (Sequencing of reads is maintained by data dependencies on the resulting
2073 primOpHasSideEffects WriteArrayOp = True
2074 primOpHasSideEffects (WriteByteArrayOp _) = True
2075 primOpHasSideEffects (WriteOffAddrOp _) = True
2076 primOpHasSideEffects WriteMutVarOp = True
2078 primOpHasSideEffects UnsafeFreezeArrayOp = True
2079 primOpHasSideEffects UnsafeFreezeByteArrayOp = True
2080 primOpHasSideEffects UnsafeThawArrayOp = True
2082 primOpHasSideEffects TakeMVarOp = True
2083 primOpHasSideEffects TryTakeMVarOp = True
2084 primOpHasSideEffects PutMVarOp = True
2085 primOpHasSideEffects DelayOp = True
2086 primOpHasSideEffects WaitReadOp = True
2087 primOpHasSideEffects WaitWriteOp = True
2089 primOpHasSideEffects ParGlobalOp = True
2090 primOpHasSideEffects ParLocalOp = True
2091 primOpHasSideEffects ParAtOp = True
2092 primOpHasSideEffects ParAtAbsOp = True
2093 primOpHasSideEffects ParAtRelOp = True
2094 primOpHasSideEffects ParAtForNowOp = True
2095 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
2096 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
2097 primOpHasSideEffects (CCallOp _) = True
2099 primOpHasSideEffects other = False
2102 Inline primitive operations that perform calls need wrappers to save
2103 any live variables that are stored in caller-saves registers.
2106 primOpNeedsWrapper :: PrimOp -> Bool
2108 primOpNeedsWrapper (CCallOp _) = True
2110 primOpNeedsWrapper Integer2IntOp = True
2111 primOpNeedsWrapper Integer2WordOp = True
2112 primOpNeedsWrapper IntegerCmpOp = True
2113 primOpNeedsWrapper IntegerCmpIntOp = True
2115 primOpNeedsWrapper FloatExpOp = True
2116 primOpNeedsWrapper FloatLogOp = True
2117 primOpNeedsWrapper FloatSqrtOp = True
2118 primOpNeedsWrapper FloatSinOp = True
2119 primOpNeedsWrapper FloatCosOp = True
2120 primOpNeedsWrapper FloatTanOp = True
2121 primOpNeedsWrapper FloatAsinOp = True
2122 primOpNeedsWrapper FloatAcosOp = True
2123 primOpNeedsWrapper FloatAtanOp = True
2124 primOpNeedsWrapper FloatSinhOp = True
2125 primOpNeedsWrapper FloatCoshOp = True
2126 primOpNeedsWrapper FloatTanhOp = True
2127 primOpNeedsWrapper FloatPowerOp = True
2129 primOpNeedsWrapper DoubleExpOp = True
2130 primOpNeedsWrapper DoubleLogOp = True
2131 primOpNeedsWrapper DoubleSqrtOp = True
2132 primOpNeedsWrapper DoubleSinOp = True
2133 primOpNeedsWrapper DoubleCosOp = True
2134 primOpNeedsWrapper DoubleTanOp = True
2135 primOpNeedsWrapper DoubleAsinOp = True
2136 primOpNeedsWrapper DoubleAcosOp = True
2137 primOpNeedsWrapper DoubleAtanOp = True
2138 primOpNeedsWrapper DoubleSinhOp = True
2139 primOpNeedsWrapper DoubleCoshOp = True
2140 primOpNeedsWrapper DoubleTanhOp = True
2141 primOpNeedsWrapper DoublePowerOp = True
2143 primOpNeedsWrapper MakeStableNameOp = True
2144 primOpNeedsWrapper DeRefStablePtrOp = True
2146 primOpNeedsWrapper DelayOp = True
2147 primOpNeedsWrapper WaitReadOp = True
2148 primOpNeedsWrapper WaitWriteOp = True
2150 primOpNeedsWrapper other_op = False
2154 primOpArity :: PrimOp -> Arity
2156 = case (primOpInfo op) of
2160 GenPrimOp occ tyvars arg_tys res_ty -> length arg_tys
2162 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
2164 = case (primOpInfo op) of
2165 Dyadic occ ty -> dyadic_fun_ty ty
2166 Monadic occ ty -> monadic_fun_ty ty
2167 Compare occ ty -> compare_fun_ty ty
2169 GenPrimOp occ tyvars arg_tys res_ty ->
2170 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
2172 mkPrimOpIdName :: PrimOp -> Id -> Name
2173 -- Make the name for the PrimOp's Id
2174 -- We have to pass in the Id itself because it's a WiredInId
2175 -- and hence recursive
2176 mkPrimOpIdName op id
2177 = mkWiredInIdName key pREL_GHC occ_name id
2179 occ_name = primOpOcc op
2180 key = mkPrimOpIdUnique (primOpTag op)
2183 primOpRdrName :: PrimOp -> RdrName
2184 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
2186 primOpOcc :: PrimOp -> OccName
2187 primOpOcc op = case (primOpInfo op) of
2189 Monadic occ _ -> occ
2190 Compare occ _ -> occ
2191 GenPrimOp occ _ _ _ -> occ
2193 -- primOpSig is like primOpType but gives the result split apart:
2194 -- (type variables, argument types, result type)
2195 -- It also gives arity, strictness info
2197 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictnessInfo)
2199 = (tyvars, arg_tys, res_ty, arity, primOpStrictness arity op)
2201 arity = length arg_tys
2202 (tyvars, arg_tys, res_ty)
2203 = case (primOpInfo op) of
2204 Monadic occ ty -> ([], [ty], ty )
2205 Dyadic occ ty -> ([], [ty,ty], ty )
2206 Compare occ ty -> ([], [ty,ty], boolTy)
2207 GenPrimOp occ tyvars arg_tys res_ty
2208 -> (tyvars, arg_tys, res_ty)
2210 -- primOpUsg is like primOpSig but the types it yields are the
2211 -- appropriate sigma (i.e., usage-annotated) types,
2212 -- as required by the UsageSP inference.
2214 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
2218 -- Refer to comment by `otherwise' clause; we need consider here
2219 -- *only* primops that have arguments or results containing Haskell
2220 -- pointers (things that are pointed). Unpointed values are
2221 -- irrelevant to the usage analysis. The issue is whether pointed
2222 -- values may be entered or duplicated by the primop.
2224 -- Remember that primops are *never* partially applied.
2226 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
2227 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
2228 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
2229 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
2230 IndexArrayOp -> mangle [mkM, mkP ] mkM
2231 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
2232 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
2234 NewMutVarOp -> mangle [mkM, mkP ] mkM
2235 ReadMutVarOp -> mangle [mkM, mkP ] mkM
2236 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
2237 SameMutVarOp -> mangle [mkP, mkP ] mkM
2239 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
2240 mangle [mkM, mkM . (inFun mkM mkM), mkP] mkM
2241 -- might use caught action multiply
2242 RaiseOp -> mangle [mkM ] mkM
2244 NewMVarOp -> mangle [mkP ] mkR
2245 TakeMVarOp -> mangle [mkM, mkP ] mkM
2246 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
2247 SameMVarOp -> mangle [mkP, mkP ] mkM
2248 TryTakeMVarOp -> mangle [mkM, mkP ] mkM
2249 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
2251 ForkOp -> mangle [mkO, mkP ] mkR
2252 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
2254 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
2255 DeRefWeakOp -> mangle [mkM, mkP ] mkM
2256 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
2258 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
2259 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
2260 EqStablePtrOp -> mangle [mkP, mkP ] mkR
2261 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
2262 EqStableNameOp -> mangle [mkP, mkP ] mkR
2263 StableNameToIntOp -> mangle [mkP ] mkR
2265 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
2267 SeqOp -> mangle [mkO ] mkR
2268 ParOp -> mangle [mkO ] mkR
2269 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2270 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2271 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2272 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2273 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
2274 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
2275 CopyableOp -> mangle [mkZ ] mkR
2276 NoFollowOp -> mangle [mkZ ] mkR
2278 CCallOp _ -> mangle [ ] mkM
2280 -- Things with no Haskell pointers inside: in actuality, usages are
2281 -- irrelevant here (hence it doesn't matter that some of these
2282 -- apparently permit duplication; since such arguments are never
2283 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
2284 -- except insofar as it propagates to infect other values that *are*
2287 otherwise -> nomangle
2289 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
2290 mkO = mkUsgTy UsOnce -- pointed argument used once
2291 mkM = mkUsgTy UsMany -- pointed argument used multiply
2292 mkP = mkUsgTy UsOnce -- unpointed argument
2293 mkR = mkUsgTy UsMany -- unpointed result
2295 (tyvars, arg_tys, res_ty, _, _) = primOpSig op
2297 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
2299 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
2301 inFun f g ty = case splitFunTy_maybe ty of
2302 Just (a,b) -> mkFunTy (f a) (g b)
2303 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
2305 inUB fs ty = case splitTyConApp_maybe ty of
2306 Just (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
2307 mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg"
2309 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
2313 data PrimOpResultInfo
2314 = ReturnsPrim PrimRep
2317 -- Some PrimOps need not return a manifest primitive or algebraic value
2318 -- (i.e. they might return a polymorphic value). These PrimOps *must*
2319 -- be out of line, or the code generator won't work.
2321 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
2322 getPrimOpResultInfo (CCallOp _)
2323 = ReturnsAlg unboxedPairTyCon
2324 getPrimOpResultInfo op
2325 = case (primOpInfo op) of
2326 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
2327 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
2328 Compare _ ty -> ReturnsAlg boolTyCon
2329 GenPrimOp _ _ _ ty ->
2330 let rep = typePrimRep ty in
2332 PtrRep -> case splitAlgTyConApp_maybe ty of
2333 Nothing -> panic "getPrimOpResultInfo"
2334 Just (tc,_,_) -> ReturnsAlg tc
2335 other -> ReturnsPrim other
2338 The commutable ops are those for which we will try to move constants
2339 to the right hand side for strength reduction.
2342 commutableOp :: PrimOp -> Bool
2344 commutableOp CharEqOp = True
2345 commutableOp CharNeOp = True
2346 commutableOp IntAddOp = True
2347 commutableOp IntMulOp = True
2348 commutableOp AndOp = True
2349 commutableOp OrOp = True
2350 commutableOp XorOp = True
2351 commutableOp IntEqOp = True
2352 commutableOp IntNeOp = True
2353 commutableOp IntegerAddOp = True
2354 commutableOp IntegerMulOp = True
2355 commutableOp IntegerGcdOp = True
2356 commutableOp IntegerIntGcdOp = True
2357 commutableOp FloatAddOp = True
2358 commutableOp FloatMulOp = True
2359 commutableOp FloatEqOp = True
2360 commutableOp FloatNeOp = True
2361 commutableOp DoubleAddOp = True
2362 commutableOp DoubleMulOp = True
2363 commutableOp DoubleEqOp = True
2364 commutableOp DoubleNeOp = True
2365 commutableOp _ = False
2370 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
2371 -- CharRep --> ([], Char#)
2372 -- StablePtrRep --> ([a], StablePtr# a)
2373 mkPrimTyApp tvs kind
2374 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
2376 tycon = primRepTyCon kind
2377 forall_tvs = take (tyConArity tycon) tvs
2379 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
2380 monadic_fun_ty ty = mkFunTy ty ty
2381 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
2386 pprPrimOp :: PrimOp -> SDoc
2388 pprPrimOp (CCallOp c_call) = pprCCallOp c_call
2390 = getPprStyle $ \ sty ->
2391 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2392 ptext SLIT("PrelGHC.") <> pprOccName occ
2396 occ = primOpOcc other_op
2400 %************************************************************************
2402 \subsubsection{CCalls}
2404 %************************************************************************
2406 A special ``trap-door'' to use in making calls direct to C functions:
2410 Bool -- True <=> really a "casm"
2411 Bool -- True <=> might invoke Haskell GC
2412 CallConv -- calling convention to use.
2416 = StaticTarget CLabelString -- An "unboxed" ccall# to `fn'.
2417 | DynamicTarget Unique -- First argument (an Addr#) is the function pointer
2418 -- (unique is used to generate a 'typedef' to cast
2419 -- the function pointer if compiling the ccall# down to
2420 -- .hc code - can't do this inline for tedious reasons.)
2423 ccallMayGC :: CCall -> Bool
2424 ccallMayGC (CCall _ _ may_gc _) = may_gc
2426 ccallIsCasm :: CCall -> Bool
2427 ccallIsCasm (CCall _ c_asm _ _) = c_asm
2431 pprCCallOp (CCall fun is_casm may_gc cconv)
2432 = hcat [ ifPprDebug callconv
2433 , text "__", ppr_dyn
2434 , text before , ppr_fun , after]
2436 callconv = text "{-" <> pprCallConv cconv <> text "-}"
2439 | is_casm && may_gc = "casm_GC ``"
2440 | is_casm = "casm ``"
2441 | may_gc = "ccall_GC "
2442 | otherwise = "ccall "
2445 | is_casm = text "''"
2448 ppr_dyn = case fun of
2449 DynamicTarget _ -> text "dyn_"
2452 ppr_fun = case fun of
2453 DynamicTarget _ -> text "\"\""
2454 StaticTarget fn -> pprCLabelString fn