2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[PrimOp]{Primitive operations (machine-level)}
8 PrimOp(..), allThePrimOps,
9 tagOf_PrimOp, -- ToDo: rm
11 primOpUniq, primOpStr,
15 primOpOutOfLine, primOpNeedsWrapper,
16 primOpOkForSpeculation, primOpIsCheap,
19 getPrimOpResultInfo, PrimOpResultInfo(..),
24 #include "HsVersions.h"
26 import PrimRep -- most of it
30 import CStrings ( identToC )
32 import CallConv ( CallConv, pprCallConv )
33 import PprType ( pprParendType )
34 import TyCon ( TyCon )
35 import Type ( mkForAllTys, mkForAllTy, mkFunTy, mkFunTys,
36 mkTyConApp, typePrimRep,
37 splitAlgTyConApp, Type, isUnboxedTupleType,
38 splitAlgTyConApp_maybe
40 import Unique ( Unique, mkPrimOpIdUnique )
43 import GlaExts ( Int(..), Int#, (==#) )
46 %************************************************************************
48 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
50 %************************************************************************
52 These are in \tr{state-interface.verb} order.
56 -- dig the FORTRAN/C influence on the names...
60 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
61 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
62 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
63 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
64 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
65 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
71 -- IntAbsOp unused?? ADR
72 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
73 | IntRemOp | IntNegOp | IntAbsOp
74 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
77 | WordQuotOp | WordRemOp
78 | AndOp | OrOp | NotOp | XorOp
79 | SllOp | SrlOp -- shift {left,right} {logical}
80 | Int2WordOp | Word2IntOp -- casts
83 | Int2AddrOp | Addr2IntOp -- casts
85 -- Float#-related ops:
86 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
87 | Float2IntOp | Int2FloatOp
89 | FloatExpOp | FloatLogOp | FloatSqrtOp
90 | FloatSinOp | FloatCosOp | FloatTanOp
91 | FloatAsinOp | FloatAcosOp | FloatAtanOp
92 | FloatSinhOp | FloatCoshOp | FloatTanhOp
93 -- not all machines have these available conveniently:
94 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
95 | FloatPowerOp -- ** op
97 -- Double#-related ops:
98 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
99 | Double2IntOp | Int2DoubleOp
100 | Double2FloatOp | Float2DoubleOp
102 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
103 | DoubleSinOp | DoubleCosOp | DoubleTanOp
104 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
105 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
106 -- not all machines have these available conveniently:
107 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
108 | DoublePowerOp -- ** op
110 -- Integer (and related...) ops:
111 -- slightly weird -- to match GMP package.
112 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
113 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
117 | Integer2IntOp | Integer2WordOp
118 | Int2IntegerOp | Word2IntegerOp
120 -- casting to/from Integer and 64-bit (un)signed quantities.
121 | IntegerToInt64Op | Int64ToIntegerOp
122 | IntegerToWord64Op | Word64ToIntegerOp
125 | FloatEncodeOp | FloatDecodeOp
126 | DoubleEncodeOp | DoubleDecodeOp
128 -- primitive ops for primitive arrays
131 | NewByteArrayOp PrimRep
134 | SameMutableByteArrayOp
136 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
138 | ReadByteArrayOp PrimRep
139 | WriteByteArrayOp PrimRep
140 | IndexByteArrayOp PrimRep
141 | IndexOffAddrOp PrimRep
142 | WriteOffAddrOp PrimRep
143 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
144 -- This is just a cheesy encoding of a bunch of ops.
145 -- Note that ForeignObjRep is not included -- the only way of
146 -- creating a ForeignObj is with a ccall or casm.
147 | IndexOffForeignObjOp PrimRep
149 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
150 | SizeofByteArrayOp | SizeofMutableByteArrayOp
179 A special ``trap-door'' to use in making calls direct to C functions:
182 FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
183 Unique) -- Right u => first argument (an Addr#) is the function pointer
184 -- (unique is used to
187 Bool -- True <=> really a "casm"
188 Bool -- True <=> might invoke Haskell GC
189 CallConv -- calling convention to use.
191 -- (... to be continued ... )
194 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
195 (See @primOpInfo@ for details.)
197 Note: that first arg and part of the result should be the system state
198 token (which we carry around to fool over-zealous optimisers) but
199 which isn't actually passed.
201 For example, we represent
203 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
209 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
210 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
214 (AlgAlts [ ( FloatPrimAndIoWorld,
216 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
222 Nota Bene: there are some people who find the empty list of types in
223 the @Prim@ somewhat puzzling and would represent the above by
227 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
228 -- :: /\ alpha1, alpha2 alpha3, alpha4.
229 -- alpha1 -> alpha2 -> alpha3 -> alpha4
230 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
233 (AlgAlts [ ( FloatPrimAndIoWorld,
235 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
241 But, this is a completely different way of using @CCallOp@. The most
242 major changes required if we switch to this are in @primOpInfo@, and
243 the desugarer. The major difficulty is in moving the HeapRequirement
244 stuff somewhere appropriate. (The advantage is that we could simplify
245 @CCallOp@ and record just the number of arguments with corresponding
246 simplifications in reading pragma unfoldings, the simplifier,
247 instantiation (etc) of core expressions, ... . Maybe we should think
248 about using it this way?? ADR)
251 -- (... continued from above ... )
253 -- Operation to test two closure addresses for equality (yes really!)
254 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
255 | ReallyUnsafePtrEqualityOp
268 | ParGlobalOp -- named global par
269 | ParLocalOp -- named local par
270 | ParAtOp -- specifies destination of local par
271 | ParAtAbsOp -- specifies destination of local par (abs processor)
272 | ParAtRelOp -- specifies destination of local par (rel processor)
273 | ParAtForNowOp -- specifies initial destination of global par
274 | CopyableOp -- marks copyable code
275 | NoFollowOp -- marks non-followup expression
278 Used for the Ord instance
281 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
282 tagOf_PrimOp CharGeOp = ILIT( 2)
283 tagOf_PrimOp CharEqOp = ILIT( 3)
284 tagOf_PrimOp CharNeOp = ILIT( 4)
285 tagOf_PrimOp CharLtOp = ILIT( 5)
286 tagOf_PrimOp CharLeOp = ILIT( 6)
287 tagOf_PrimOp IntGtOp = ILIT( 7)
288 tagOf_PrimOp IntGeOp = ILIT( 8)
289 tagOf_PrimOp IntEqOp = ILIT( 9)
290 tagOf_PrimOp IntNeOp = ILIT( 10)
291 tagOf_PrimOp IntLtOp = ILIT( 11)
292 tagOf_PrimOp IntLeOp = ILIT( 12)
293 tagOf_PrimOp WordGtOp = ILIT( 13)
294 tagOf_PrimOp WordGeOp = ILIT( 14)
295 tagOf_PrimOp WordEqOp = ILIT( 15)
296 tagOf_PrimOp WordNeOp = ILIT( 16)
297 tagOf_PrimOp WordLtOp = ILIT( 17)
298 tagOf_PrimOp WordLeOp = ILIT( 18)
299 tagOf_PrimOp AddrGtOp = ILIT( 19)
300 tagOf_PrimOp AddrGeOp = ILIT( 20)
301 tagOf_PrimOp AddrEqOp = ILIT( 21)
302 tagOf_PrimOp AddrNeOp = ILIT( 22)
303 tagOf_PrimOp AddrLtOp = ILIT( 23)
304 tagOf_PrimOp AddrLeOp = ILIT( 24)
305 tagOf_PrimOp FloatGtOp = ILIT( 25)
306 tagOf_PrimOp FloatGeOp = ILIT( 26)
307 tagOf_PrimOp FloatEqOp = ILIT( 27)
308 tagOf_PrimOp FloatNeOp = ILIT( 28)
309 tagOf_PrimOp FloatLtOp = ILIT( 29)
310 tagOf_PrimOp FloatLeOp = ILIT( 30)
311 tagOf_PrimOp DoubleGtOp = ILIT( 31)
312 tagOf_PrimOp DoubleGeOp = ILIT( 32)
313 tagOf_PrimOp DoubleEqOp = ILIT( 33)
314 tagOf_PrimOp DoubleNeOp = ILIT( 34)
315 tagOf_PrimOp DoubleLtOp = ILIT( 35)
316 tagOf_PrimOp DoubleLeOp = ILIT( 36)
317 tagOf_PrimOp OrdOp = ILIT( 37)
318 tagOf_PrimOp ChrOp = ILIT( 38)
319 tagOf_PrimOp IntAddOp = ILIT( 39)
320 tagOf_PrimOp IntSubOp = ILIT( 40)
321 tagOf_PrimOp IntMulOp = ILIT( 41)
322 tagOf_PrimOp IntQuotOp = ILIT( 42)
323 tagOf_PrimOp IntRemOp = ILIT( 43)
324 tagOf_PrimOp IntNegOp = ILIT( 44)
325 tagOf_PrimOp IntAbsOp = ILIT( 45)
326 tagOf_PrimOp WordQuotOp = ILIT( 46)
327 tagOf_PrimOp WordRemOp = ILIT( 47)
328 tagOf_PrimOp AndOp = ILIT( 48)
329 tagOf_PrimOp OrOp = ILIT( 49)
330 tagOf_PrimOp NotOp = ILIT( 50)
331 tagOf_PrimOp XorOp = ILIT( 51)
332 tagOf_PrimOp SllOp = ILIT( 52)
333 tagOf_PrimOp SrlOp = ILIT( 53)
334 tagOf_PrimOp ISllOp = ILIT( 54)
335 tagOf_PrimOp ISraOp = ILIT( 55)
336 tagOf_PrimOp ISrlOp = ILIT( 56)
337 tagOf_PrimOp Int2WordOp = ILIT( 57)
338 tagOf_PrimOp Word2IntOp = ILIT( 58)
339 tagOf_PrimOp Int2AddrOp = ILIT( 59)
340 tagOf_PrimOp Addr2IntOp = ILIT( 60)
342 tagOf_PrimOp FloatAddOp = ILIT( 61)
343 tagOf_PrimOp FloatSubOp = ILIT( 62)
344 tagOf_PrimOp FloatMulOp = ILIT( 63)
345 tagOf_PrimOp FloatDivOp = ILIT( 64)
346 tagOf_PrimOp FloatNegOp = ILIT( 65)
347 tagOf_PrimOp Float2IntOp = ILIT( 66)
348 tagOf_PrimOp Int2FloatOp = ILIT( 67)
349 tagOf_PrimOp FloatExpOp = ILIT( 68)
350 tagOf_PrimOp FloatLogOp = ILIT( 69)
351 tagOf_PrimOp FloatSqrtOp = ILIT( 70)
352 tagOf_PrimOp FloatSinOp = ILIT( 71)
353 tagOf_PrimOp FloatCosOp = ILIT( 72)
354 tagOf_PrimOp FloatTanOp = ILIT( 73)
355 tagOf_PrimOp FloatAsinOp = ILIT( 74)
356 tagOf_PrimOp FloatAcosOp = ILIT( 75)
357 tagOf_PrimOp FloatAtanOp = ILIT( 76)
358 tagOf_PrimOp FloatSinhOp = ILIT( 77)
359 tagOf_PrimOp FloatCoshOp = ILIT( 78)
360 tagOf_PrimOp FloatTanhOp = ILIT( 79)
361 tagOf_PrimOp FloatPowerOp = ILIT( 80)
363 tagOf_PrimOp DoubleAddOp = ILIT( 81)
364 tagOf_PrimOp DoubleSubOp = ILIT( 82)
365 tagOf_PrimOp DoubleMulOp = ILIT( 83)
366 tagOf_PrimOp DoubleDivOp = ILIT( 84)
367 tagOf_PrimOp DoubleNegOp = ILIT( 85)
368 tagOf_PrimOp Double2IntOp = ILIT( 86)
369 tagOf_PrimOp Int2DoubleOp = ILIT( 87)
370 tagOf_PrimOp Double2FloatOp = ILIT( 88)
371 tagOf_PrimOp Float2DoubleOp = ILIT( 89)
372 tagOf_PrimOp DoubleExpOp = ILIT( 90)
373 tagOf_PrimOp DoubleLogOp = ILIT( 91)
374 tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
375 tagOf_PrimOp DoubleSinOp = ILIT( 93)
376 tagOf_PrimOp DoubleCosOp = ILIT( 94)
377 tagOf_PrimOp DoubleTanOp = ILIT( 95)
378 tagOf_PrimOp DoubleAsinOp = ILIT( 96)
379 tagOf_PrimOp DoubleAcosOp = ILIT( 97)
380 tagOf_PrimOp DoubleAtanOp = ILIT( 98)
381 tagOf_PrimOp DoubleSinhOp = ILIT( 99)
382 tagOf_PrimOp DoubleCoshOp = ILIT(100)
383 tagOf_PrimOp DoubleTanhOp = ILIT(101)
384 tagOf_PrimOp DoublePowerOp = ILIT(102)
386 tagOf_PrimOp IntegerAddOp = ILIT(103)
387 tagOf_PrimOp IntegerSubOp = ILIT(104)
388 tagOf_PrimOp IntegerMulOp = ILIT(105)
389 tagOf_PrimOp IntegerGcdOp = ILIT(106)
390 tagOf_PrimOp IntegerQuotRemOp = ILIT(107)
391 tagOf_PrimOp IntegerDivModOp = ILIT(108)
392 tagOf_PrimOp IntegerNegOp = ILIT(109)
393 tagOf_PrimOp IntegerCmpOp = ILIT(110)
394 tagOf_PrimOp Integer2IntOp = ILIT(111)
395 tagOf_PrimOp Integer2WordOp = ILIT(112)
396 tagOf_PrimOp Int2IntegerOp = ILIT(113)
397 tagOf_PrimOp Word2IntegerOp = ILIT(114)
398 tagOf_PrimOp Addr2IntegerOp = ILIT(115)
399 tagOf_PrimOp IntegerToInt64Op = ILIT(116)
400 tagOf_PrimOp Int64ToIntegerOp = ILIT(117)
401 tagOf_PrimOp IntegerToWord64Op = ILIT(118)
402 tagOf_PrimOp Word64ToIntegerOp = ILIT(119)
404 tagOf_PrimOp FloatEncodeOp = ILIT(120)
405 tagOf_PrimOp FloatDecodeOp = ILIT(121)
406 tagOf_PrimOp DoubleEncodeOp = ILIT(122)
407 tagOf_PrimOp DoubleDecodeOp = ILIT(123)
409 tagOf_PrimOp NewArrayOp = ILIT(124)
410 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(125)
411 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(126)
412 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(127)
413 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(128)
414 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(129)
415 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(130)
416 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(131)
417 tagOf_PrimOp SameMutableArrayOp = ILIT(132)
418 tagOf_PrimOp SameMutableByteArrayOp = ILIT(133)
419 tagOf_PrimOp ReadArrayOp = ILIT(134)
420 tagOf_PrimOp WriteArrayOp = ILIT(135)
421 tagOf_PrimOp IndexArrayOp = ILIT(136)
423 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(137)
424 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(138)
425 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(139)
426 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(140)
427 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(141)
428 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(142)
429 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(143)
430 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(144)
431 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(145)
433 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(146)
434 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147)
435 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148)
436 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(149)
437 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(150)
438 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(151)
439 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(152)
440 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(153)
441 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(154)
443 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(155)
444 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(156)
445 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(157)
446 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(158)
447 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(159)
448 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(160)
449 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(161)
450 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(162)
451 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(163)
453 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(164)
454 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(165)
455 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(166)
456 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(167)
457 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(168)
458 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(169)
459 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(170)
460 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(171)
461 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(172)
462 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(173)
463 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(174)
464 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(175)
465 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(176)
466 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(177)
467 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(178)
468 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(179)
469 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(180)
470 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(181)
472 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(182)
473 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(183)
474 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(184)
475 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(185)
476 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(186)
477 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(187)
478 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(188)
479 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(189)
480 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(190)
481 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(191)
483 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(192)
484 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(193)
485 tagOf_PrimOp SizeofByteArrayOp = ILIT(194)
486 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(195)
487 tagOf_PrimOp NewMVarOp = ILIT(196)
488 tagOf_PrimOp TakeMVarOp = ILIT(197)
489 tagOf_PrimOp PutMVarOp = ILIT(198)
490 tagOf_PrimOp SameMVarOp = ILIT(199)
491 tagOf_PrimOp MakeForeignObjOp = ILIT(200)
492 tagOf_PrimOp WriteForeignObjOp = ILIT(201)
493 tagOf_PrimOp MkWeakOp = ILIT(202)
494 tagOf_PrimOp DeRefWeakOp = ILIT(203)
495 tagOf_PrimOp MakeStablePtrOp = ILIT(204)
496 tagOf_PrimOp DeRefStablePtrOp = ILIT(205)
497 tagOf_PrimOp EqStablePtrOp = ILIT(206)
498 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(207)
499 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(208)
500 tagOf_PrimOp SeqOp = ILIT(209)
501 tagOf_PrimOp ParOp = ILIT(210)
502 tagOf_PrimOp ForkOp = ILIT(211)
503 tagOf_PrimOp KillThreadOp = ILIT(212)
504 tagOf_PrimOp DelayOp = ILIT(213)
505 tagOf_PrimOp WaitReadOp = ILIT(214)
506 tagOf_PrimOp WaitWriteOp = ILIT(215)
507 tagOf_PrimOp ParGlobalOp = ILIT(216)
508 tagOf_PrimOp ParLocalOp = ILIT(217)
509 tagOf_PrimOp ParAtOp = ILIT(218)
510 tagOf_PrimOp ParAtAbsOp = ILIT(219)
511 tagOf_PrimOp ParAtRelOp = ILIT(220)
512 tagOf_PrimOp ParAtForNowOp = ILIT(221)
513 tagOf_PrimOp CopyableOp = ILIT(222)
514 tagOf_PrimOp NoFollowOp = ILIT(223)
515 tagOf_PrimOp NewMutVarOp = ILIT(224)
516 tagOf_PrimOp ReadMutVarOp = ILIT(225)
517 tagOf_PrimOp WriteMutVarOp = ILIT(226)
518 tagOf_PrimOp SameMutVarOp = ILIT(227)
519 tagOf_PrimOp CatchOp = ILIT(228)
520 tagOf_PrimOp RaiseOp = ILIT(229)
522 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
523 --panic# "tagOf_PrimOp: pattern-match"
525 instance Eq PrimOp where
526 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
528 instance Ord PrimOp where
529 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
530 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
531 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
532 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
533 op1 `compare` op2 | op1 < op2 = LT
537 instance Outputable PrimOp where
538 ppr op = pprPrimOp op
540 instance Show PrimOp where
541 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
544 An @Enum@-derived list would be better; meanwhile... (ToDo)
671 NewByteArrayOp CharRep,
672 NewByteArrayOp IntRep,
673 NewByteArrayOp WordRep,
674 NewByteArrayOp AddrRep,
675 NewByteArrayOp FloatRep,
676 NewByteArrayOp DoubleRep,
677 NewByteArrayOp StablePtrRep,
679 SameMutableByteArrayOp,
683 ReadByteArrayOp CharRep,
684 ReadByteArrayOp IntRep,
685 ReadByteArrayOp WordRep,
686 ReadByteArrayOp AddrRep,
687 ReadByteArrayOp FloatRep,
688 ReadByteArrayOp DoubleRep,
689 ReadByteArrayOp StablePtrRep,
690 ReadByteArrayOp Int64Rep,
691 ReadByteArrayOp Word64Rep,
692 WriteByteArrayOp CharRep,
693 WriteByteArrayOp IntRep,
694 WriteByteArrayOp WordRep,
695 WriteByteArrayOp AddrRep,
696 WriteByteArrayOp FloatRep,
697 WriteByteArrayOp DoubleRep,
698 WriteByteArrayOp StablePtrRep,
699 WriteByteArrayOp Int64Rep,
700 WriteByteArrayOp Word64Rep,
701 IndexByteArrayOp CharRep,
702 IndexByteArrayOp IntRep,
703 IndexByteArrayOp WordRep,
704 IndexByteArrayOp AddrRep,
705 IndexByteArrayOp FloatRep,
706 IndexByteArrayOp DoubleRep,
707 IndexByteArrayOp StablePtrRep,
708 IndexByteArrayOp Int64Rep,
709 IndexByteArrayOp Word64Rep,
710 IndexOffForeignObjOp CharRep,
711 IndexOffForeignObjOp AddrRep,
712 IndexOffForeignObjOp IntRep,
713 IndexOffForeignObjOp WordRep,
714 IndexOffForeignObjOp FloatRep,
715 IndexOffForeignObjOp DoubleRep,
716 IndexOffForeignObjOp StablePtrRep,
717 IndexOffForeignObjOp Int64Rep,
718 IndexOffForeignObjOp Word64Rep,
719 IndexOffAddrOp CharRep,
720 IndexOffAddrOp IntRep,
721 IndexOffAddrOp WordRep,
722 IndexOffAddrOp AddrRep,
723 IndexOffAddrOp FloatRep,
724 IndexOffAddrOp DoubleRep,
725 IndexOffAddrOp StablePtrRep,
726 IndexOffAddrOp Int64Rep,
727 IndexOffAddrOp Word64Rep,
728 WriteOffAddrOp CharRep,
729 WriteOffAddrOp IntRep,
730 WriteOffAddrOp WordRep,
731 WriteOffAddrOp AddrRep,
732 WriteOffAddrOp FloatRep,
733 WriteOffAddrOp DoubleRep,
734 WriteOffAddrOp ForeignObjRep,
735 WriteOffAddrOp StablePtrRep,
736 WriteOffAddrOp Int64Rep,
737 WriteOffAddrOp Word64Rep,
739 UnsafeFreezeByteArrayOp,
741 SizeofMutableByteArrayOp,
759 ReallyUnsafePtrEqualityOp,
778 %************************************************************************
780 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
782 %************************************************************************
784 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
785 refer to the primitive operation. The conventional \tr{#}-for-
786 unboxed ops is added on later.
788 The reason for the funny characters in the names is so we do not
789 interfere with the programmer's Haskell name spaces.
791 We use @PrimKinds@ for the ``type'' information, because they're
792 (slightly) more convenient to use than @TyCons@.
795 = Dyadic FAST_STRING -- string :: T -> T -> T
797 | Monadic FAST_STRING -- string :: T -> T
799 | Compare FAST_STRING -- string :: T -> T -> Bool
802 | GenPrimOp FAST_STRING -- string :: \/a1..an . T1 -> .. -> Tk -> T
810 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
812 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
813 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
814 an_Integer_and_Int_tys
815 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
818 unboxedPair = mkUnboxedTupleTy 2
819 unboxedTriple = mkUnboxedTupleTy 3
820 unboxedQuadruple = mkUnboxedTupleTy 4
821 unboxedSexTuple = mkUnboxedTupleTy 6
823 integerMonadic name = GenPrimOp name [] one_Integer_ty
824 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
826 integerDyadic name = GenPrimOp name [] two_Integer_tys
827 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
829 integerDyadic2Results name = GenPrimOp name [] two_Integer_tys
830 (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy,
831 intPrimTy, intPrimTy, byteArrayPrimTy])
833 integerCompare name = GenPrimOp name [] two_Integer_tys intPrimTy
836 %************************************************************************
838 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
840 %************************************************************************
842 @primOpInfo@ gives all essential information (from which everything
843 else, notably a type, can be constructed) for each @PrimOp@.
846 primOpInfo :: PrimOp -> PrimOpInfo
849 There's plenty of this stuff!
852 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
853 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
854 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
855 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
856 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
857 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
859 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
860 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
861 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
862 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
863 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
864 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
866 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
867 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
868 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
869 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
870 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
871 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
873 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
874 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
875 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
876 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
877 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
878 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
880 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
881 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
882 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
883 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
884 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
885 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
887 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
888 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
889 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
890 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
891 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
892 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
896 %************************************************************************
898 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
900 %************************************************************************
903 primOpInfo OrdOp = GenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
904 primOpInfo ChrOp = GenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
907 %************************************************************************
909 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
911 %************************************************************************
914 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
915 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
916 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
917 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
918 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
920 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
921 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
924 %************************************************************************
926 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
928 %************************************************************************
930 A @Word#@ is an unsigned @Int#@.
933 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
934 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
936 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
937 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
938 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
939 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
942 = GenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
944 = GenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
947 = GenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
949 = GenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
951 = GenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
953 primOpInfo Int2WordOp = GenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
954 primOpInfo Word2IntOp = GenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
957 %************************************************************************
959 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
961 %************************************************************************
964 primOpInfo Int2AddrOp = GenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
965 primOpInfo Addr2IntOp = GenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
969 %************************************************************************
971 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
973 %************************************************************************
975 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
979 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
980 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
981 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
982 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
983 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
985 primOpInfo Float2IntOp = GenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
986 primOpInfo Int2FloatOp = GenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
988 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
989 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
990 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
991 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
992 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
993 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
994 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
995 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
996 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
997 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
998 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
999 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
1000 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
1003 %************************************************************************
1005 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1007 %************************************************************************
1009 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
1013 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
1014 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
1015 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
1016 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
1017 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
1019 primOpInfo Double2IntOp = GenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1020 primOpInfo Int2DoubleOp = GenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1022 primOpInfo Double2FloatOp = GenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1023 primOpInfo Float2DoubleOp = GenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1025 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
1026 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
1027 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
1028 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
1029 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
1030 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
1031 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
1032 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
1033 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
1034 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
1035 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
1036 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
1037 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
1040 %************************************************************************
1042 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1044 %************************************************************************
1047 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1049 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1050 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1051 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1052 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1054 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1056 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1057 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1059 primOpInfo Integer2IntOp
1060 = GenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1062 primOpInfo Integer2WordOp
1063 = GenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1065 primOpInfo Int2IntegerOp
1066 = GenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1067 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1069 primOpInfo Word2IntegerOp
1070 = GenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1071 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1073 primOpInfo Addr2IntegerOp
1074 = GenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1075 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1077 primOpInfo IntegerToInt64Op
1078 = GenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1080 primOpInfo Int64ToIntegerOp
1081 = GenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1082 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1084 primOpInfo Word64ToIntegerOp
1085 = GenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1086 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1088 primOpInfo IntegerToWord64Op
1089 = GenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1092 Encoding and decoding of floating-point numbers is sorta
1096 primOpInfo FloatEncodeOp
1097 = GenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
1099 primOpInfo DoubleEncodeOp
1100 = GenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
1102 primOpInfo FloatDecodeOp
1103 = GenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1104 (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
1105 primOpInfo DoubleDecodeOp
1106 = GenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1107 (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
1110 %************************************************************************
1112 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1114 %************************************************************************
1117 primOpInfo NewArrayOp
1119 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1120 state = mkStatePrimTy s
1122 GenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1123 [intPrimTy, elt, state]
1124 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1126 primOpInfo (NewByteArrayOp kind)
1128 s = alphaTy; s_tv = alphaTyVar
1130 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1131 state = mkStatePrimTy s
1133 GenPrimOp op_str [s_tv]
1135 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1137 ---------------------------------------------------------------------------
1139 primOpInfo SameMutableArrayOp
1141 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1142 mut_arr_ty = mkMutableArrayPrimTy s elt
1144 GenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1147 primOpInfo SameMutableByteArrayOp
1149 s = alphaTy; s_tv = alphaTyVar;
1150 mut_arr_ty = mkMutableByteArrayPrimTy s
1152 GenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1155 ---------------------------------------------------------------------------
1156 -- Primitive arrays of Haskell pointers:
1158 primOpInfo ReadArrayOp
1160 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1161 state = mkStatePrimTy s
1163 GenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1164 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1165 (unboxedPair [state, elt])
1168 primOpInfo WriteArrayOp
1170 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1172 GenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1173 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1176 primOpInfo IndexArrayOp
1177 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1178 GenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1179 (unboxedPair [realWorldStatePrimTy, elt])
1181 ---------------------------------------------------------------------------
1182 -- Primitive arrays full of unboxed bytes:
1184 primOpInfo (ReadByteArrayOp kind)
1186 s = alphaTy; s_tv = alphaTyVar
1188 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1189 relevant_type = assoc "primOpInfo{ReadByteArrayOp}" tbl kind
1190 state = mkStatePrimTy s
1193 | kind == StablePtrRep = [s_tv, betaTyVar]
1194 | otherwise = [s_tv]
1196 GenPrimOp op_str tvs
1197 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1198 (unboxedPair [state, relevant_type])
1200 tbl = [ (CharRep, charPrimTy),
1201 (IntRep, intPrimTy),
1202 (WordRep, wordPrimTy),
1203 (AddrRep, addrPrimTy),
1204 (FloatRep, floatPrimTy),
1205 (StablePtrRep, mkStablePtrPrimTy betaTy),
1206 (DoubleRep, doublePrimTy) ]
1208 -- How come there's no Word byte arrays? ADR
1210 primOpInfo (WriteByteArrayOp kind)
1212 s = alphaTy; s_tv = alphaTyVar
1213 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1214 prim_ty = mkTyConApp (primRepTyCon kind) []
1217 | kind == StablePtrRep = (mkStablePtrPrimTy betaTy, [s_tv, betaTyVar])
1218 | otherwise = (prim_ty, [s_tv])
1221 GenPrimOp op_str tvs
1222 [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
1225 primOpInfo (IndexByteArrayOp kind)
1227 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1229 (prim_tycon_args, tvs)
1230 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1231 | otherwise = ([],[])
1233 GenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy]
1234 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1236 primOpInfo (IndexOffForeignObjOp kind)
1238 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1240 (prim_tycon_args, tvs)
1241 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1242 | otherwise = ([], [])
1244 GenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy]
1245 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1247 primOpInfo (IndexOffAddrOp kind)
1249 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1251 (prim_tycon_args, tvs)
1252 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1253 | otherwise = ([], [])
1255 GenPrimOp op_str tvs [addrPrimTy, intPrimTy]
1256 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1258 primOpInfo (WriteOffAddrOp kind)
1260 s = alphaTy; s_tv = alphaTyVar
1261 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1262 prim_ty = mkTyConApp (primRepTyCon kind) []
1264 GenPrimOp op_str [s_tv]
1265 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1268 ---------------------------------------------------------------------------
1269 primOpInfo UnsafeFreezeArrayOp
1271 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1272 state = mkStatePrimTy s
1274 GenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1275 [mkMutableArrayPrimTy s elt, state]
1276 (unboxedPair [state, mkArrayPrimTy elt])
1278 primOpInfo UnsafeFreezeByteArrayOp
1280 s = alphaTy; s_tv = alphaTyVar;
1281 state = mkStatePrimTy s
1283 GenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1284 [mkMutableByteArrayPrimTy s, state]
1285 (unboxedPair [state, byteArrayPrimTy])
1287 ---------------------------------------------------------------------------
1288 primOpInfo SizeofByteArrayOp
1290 SLIT("sizeofByteArray#") []
1294 primOpInfo SizeofMutableByteArrayOp
1295 = let { s = alphaTy; s_tv = alphaTyVar } in
1297 SLIT("sizeofMutableByteArray#") [s_tv]
1298 [mkMutableByteArrayPrimTy s]
1303 %************************************************************************
1305 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1307 %************************************************************************
1310 primOpInfo NewMutVarOp
1312 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1313 state = mkStatePrimTy s
1315 GenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1317 (unboxedPair [state, mkMutVarPrimTy s elt])
1319 primOpInfo ReadMutVarOp
1321 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1322 state = mkStatePrimTy s
1324 GenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1325 [mkMutVarPrimTy s elt, state]
1326 (unboxedPair [state, elt])
1329 primOpInfo WriteMutVarOp
1331 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1333 GenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1334 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1337 primOpInfo SameMutVarOp
1339 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1340 mut_var_ty = mkMutVarPrimTy s elt
1342 GenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1346 %************************************************************************
1348 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1350 %************************************************************************
1352 catch :: IO a -> (IOError -> IO a) -> IO a
1353 catch :: a -> (b -> a) -> a
1358 a = alphaTy; a_tv = alphaTyVar;
1359 b = betaTy; b_tv = betaTyVar;
1361 GenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
1365 a = alphaTy; a_tv = alphaTyVar;
1366 b = betaTy; b_tv = betaTyVar;
1368 GenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1371 %************************************************************************
1373 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1375 %************************************************************************
1378 primOpInfo NewMVarOp
1380 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1381 state = mkStatePrimTy s
1383 GenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1384 (unboxedPair [state, mkMVarPrimTy s elt])
1386 primOpInfo TakeMVarOp
1388 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1389 state = mkStatePrimTy s
1391 GenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1392 [mkMVarPrimTy s elt, state]
1393 (unboxedPair [state, elt])
1395 primOpInfo PutMVarOp
1397 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1399 GenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1400 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1403 primOpInfo SameMVarOp
1405 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1406 mvar_ty = mkMVarPrimTy s elt
1408 GenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1411 %************************************************************************
1413 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1415 %************************************************************************
1421 s = alphaTy; s_tv = alphaTyVar
1423 GenPrimOp SLIT("delay#") [s_tv]
1424 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1426 primOpInfo WaitReadOp
1428 s = alphaTy; s_tv = alphaTyVar
1430 GenPrimOp SLIT("waitRead#") [s_tv]
1431 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1433 primOpInfo WaitWriteOp
1435 s = alphaTy; s_tv = alphaTyVar
1437 GenPrimOp SLIT("waitWrite#") [s_tv]
1438 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1441 %************************************************************************
1443 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1445 %************************************************************************
1448 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1450 = GenPrimOp SLIT("fork#") [alphaTyVar]
1451 [alphaTy, realWorldStatePrimTy]
1452 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1454 -- killThread# :: ThreadId# -> State# RealWorld -> State# RealWorld
1455 primOpInfo KillThreadOp
1456 = GenPrimOp SLIT("killThread#") []
1457 [threadIdPrimTy, realWorldStatePrimTy]
1458 realWorldStatePrimTy
1461 ************************************************************************
1463 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1465 %************************************************************************
1468 primOpInfo MakeForeignObjOp
1469 = GenPrimOp SLIT("makeForeignObj#") []
1470 [addrPrimTy, realWorldStatePrimTy]
1471 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1473 primOpInfo WriteForeignObjOp
1475 s = alphaTy; s_tv = alphaTyVar
1477 GenPrimOp SLIT("writeForeignObj#") [s_tv]
1478 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1481 ************************************************************************
1483 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1485 %************************************************************************
1487 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1489 mkWeak# :: k -> v -> f -> State# RealWorld
1490 -> (# State# RealWorld, Weak# v #)
1492 In practice, you'll use the higher-level
1494 data Weak v = Weak# v
1495 mkWeak :: k -> v -> IO () -> IO (Weak v)
1499 = GenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
1500 [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
1501 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1504 The following operation dereferences a weak pointer. The weak pointer
1505 may have been finalised, so the operation returns a result code which
1506 must be inspected before looking at the dereferenced value.
1508 deRefWeak# :: Weak# v -> State# RealWorld ->
1509 (# State# RealWorld, v, Int# #)
1511 Only look at v if the Int# returned is /= 0 !!
1513 The higher-level op is
1515 deRefWeak :: Weak v -> IO (Maybe v)
1518 primOpInfo DeRefWeakOp
1519 = GenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1520 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1521 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1524 %************************************************************************
1526 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1528 %************************************************************************
1530 A {\em stable pointer} is an index into a table of pointers into the
1531 heap. Since the garbage collector is told about stable pointers, it
1532 is safe to pass a stable pointer to external systems such as C
1535 Here's what the operations and types are supposed to be (from
1536 state-interface document).
1539 makeStablePtr# :: a -> State# _RealWorld -> (# State# _RealWorld, a #)
1540 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1541 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> (# State# _RealWorld, a #)
1542 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1545 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1546 operation since it doesn't (directly) involve IO operations. The
1547 reason is that if some optimisation pass decided to duplicate calls to
1548 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1549 massive space leak can result. Putting it into the PrimIO monad
1550 prevents this. (Another reason for putting them in a monad is to
1551 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1554 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1555 besides, it's not likely to be used from Haskell) so it's not a
1558 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1561 primOpInfo MakeStablePtrOp
1562 = GenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1563 [alphaTy, realWorldStatePrimTy]
1564 (unboxedPair [realWorldStatePrimTy,
1565 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1567 primOpInfo DeRefStablePtrOp
1568 = GenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1569 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1570 (unboxedPair [realWorldStatePrimTy, alphaTy])
1572 primOpInfo EqStablePtrOp
1573 = GenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1574 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1578 %************************************************************************
1580 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1582 %************************************************************************
1584 [Alastair Reid is to blame for this!]
1586 These days, (Glasgow) Haskell seems to have a bit of everything from
1587 other languages: strict operations, mutable variables, sequencing,
1588 pointers, etc. About the only thing left is LISP's ability to test
1589 for pointer equality. So, let's add it in!
1592 reallyUnsafePtrEquality :: a -> a -> Int#
1595 which tests any two closures (of the same type) to see if they're the
1596 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1597 difficulties of trying to box up the result.)
1599 NB This is {\em really unsafe\/} because even something as trivial as
1600 a garbage collection might change the answer by removing indirections.
1601 Still, no-one's forcing you to use it. If you're worried about little
1602 things like loss of referential transparency, you might like to wrap
1603 it all up in a monad-like thing as John O'Donnell and John Hughes did
1604 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1607 I'm thinking of using it to speed up a critical equality test in some
1608 graphics stuff in a context where the possibility of saying that
1609 denotationally equal things aren't isn't a problem (as long as it
1610 doesn't happen too often.) ADR
1612 To Will: Jim said this was already in, but I can't see it so I'm
1613 adding it. Up to you whether you add it. (Note that this could have
1614 been readily implemented using a @veryDangerousCCall@ before they were
1618 primOpInfo ReallyUnsafePtrEqualityOp
1619 = GenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1620 [alphaTy, alphaTy] intPrimTy
1623 %************************************************************************
1625 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1627 %************************************************************************
1630 primOpInfo SeqOp -- seq# :: a -> Int#
1631 = GenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1633 primOpInfo ParOp -- par# :: a -> Int#
1634 = GenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1638 -- HWL: The first 4 Int# in all par... annotations denote:
1639 -- name, granularity info, size of result, degree of parallelism
1640 -- Same structure as _seq_ i.e. returns Int#
1642 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1643 = GenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1645 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1646 = GenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1648 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1649 = GenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1651 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1652 = GenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1654 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1655 = GenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1657 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1658 = GenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1660 primOpInfo CopyableOp -- copyable# :: a -> a
1661 = GenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1663 primOpInfo NoFollowOp -- noFollow# :: a -> a
1664 = GenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1667 %************************************************************************
1669 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1671 %************************************************************************
1674 primOpInfo (CCallOp _ _ _ _)
1675 = GenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
1678 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1679 = GenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
1681 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1684 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1688 Some PrimOps need to be called out-of-line because they either need to
1689 perform a heap check or they block.
1702 NewByteArrayOp _ -> True
1703 IntegerAddOp -> True
1704 IntegerSubOp -> True
1705 IntegerMulOp -> True
1706 IntegerGcdOp -> True
1707 IntegerQuotRemOp -> True
1708 IntegerDivModOp -> True
1709 Int2IntegerOp -> True
1710 Word2IntegerOp -> True
1711 Addr2IntegerOp -> True
1712 Word64ToIntegerOp -> True
1713 Int64ToIntegerOp -> True
1714 FloatDecodeOp -> True
1715 DoubleDecodeOp -> True
1718 MakeForeignObjOp -> True
1719 MakeStablePtrOp -> True
1723 KillThreadOp -> True
1724 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
1728 Sometimes we may choose to execute a PrimOp even though it isn't
1729 certain that its result will be required; ie execute them
1730 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1731 this is OK, because PrimOps are usually cheap, but it isn't OK for
1732 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1734 See also @primOpIsCheap@ (below).
1736 PrimOps that have side effects also should not be executed speculatively
1737 or by data dependencies.
1740 primOpOkForSpeculation :: PrimOp -> Bool
1741 primOpOkForSpeculation op
1742 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1745 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1746 WARNING), we just borrow some other predicates for a
1747 what-should-be-good-enough test. "Cheap" means willing to call it more
1748 than once. Evaluation order is unaffected.
1751 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
1755 primOpCanFail :: PrimOp -> Bool
1757 primOpCanFail IntQuotOp = True -- Divide by zero
1758 primOpCanFail IntRemOp = True -- Divide by zero
1761 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
1762 primOpCanFail IntegerDivModOp = True -- Divide by zero
1764 -- Float. ToDo: tan? tanh?
1765 primOpCanFail FloatDivOp = True -- Divide by zero
1766 primOpCanFail FloatLogOp = True -- Log of zero
1767 primOpCanFail FloatAsinOp = True -- Arg out of domain
1768 primOpCanFail FloatAcosOp = True -- Arg out of domain
1770 -- Double. ToDo: tan? tanh?
1771 primOpCanFail DoubleDivOp = True -- Divide by zero
1772 primOpCanFail DoubleLogOp = True -- Log of zero
1773 primOpCanFail DoubleAsinOp = True -- Arg out of domain
1774 primOpCanFail DoubleAcosOp = True -- Arg out of domain
1776 -- The default is "yes it's ok for speculation"
1777 primOpCanFail other_op = True
1780 And some primops have side-effects and so, for example, must not be
1784 primOpHasSideEffects :: PrimOp -> Bool
1786 primOpHasSideEffects TakeMVarOp = True
1787 primOpHasSideEffects DelayOp = True
1788 primOpHasSideEffects WaitReadOp = True
1789 primOpHasSideEffects WaitWriteOp = True
1791 primOpHasSideEffects ParOp = True
1792 primOpHasSideEffects ForkOp = True
1793 primOpHasSideEffects KillThreadOp = True
1794 primOpHasSideEffects SeqOp = True
1796 primOpHasSideEffects MakeForeignObjOp = True
1797 primOpHasSideEffects WriteForeignObjOp = True
1798 primOpHasSideEffects MkWeakOp = True
1799 primOpHasSideEffects DeRefWeakOp = True
1800 primOpHasSideEffects MakeStablePtrOp = True
1801 primOpHasSideEffects EqStablePtrOp = True -- SOF
1802 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
1804 primOpHasSideEffects ParGlobalOp = True
1805 primOpHasSideEffects ParLocalOp = True
1806 primOpHasSideEffects ParAtOp = True
1807 primOpHasSideEffects ParAtAbsOp = True
1808 primOpHasSideEffects ParAtRelOp = True
1809 primOpHasSideEffects ParAtForNowOp = True
1810 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
1811 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
1814 primOpHasSideEffects (CCallOp _ _ _ _) = True
1816 primOpHasSideEffects other = False
1819 Inline primitive operations that perform calls need wrappers to save
1820 any live variables that are stored in caller-saves registers.
1823 primOpNeedsWrapper :: PrimOp -> Bool
1825 primOpNeedsWrapper (CCallOp _ _ _ _) = True
1827 primOpNeedsWrapper Integer2IntOp = True
1828 primOpNeedsWrapper Integer2WordOp = True
1829 primOpNeedsWrapper IntegerCmpOp = True
1831 primOpNeedsWrapper FloatExpOp = True
1832 primOpNeedsWrapper FloatLogOp = True
1833 primOpNeedsWrapper FloatSqrtOp = True
1834 primOpNeedsWrapper FloatSinOp = True
1835 primOpNeedsWrapper FloatCosOp = True
1836 primOpNeedsWrapper FloatTanOp = True
1837 primOpNeedsWrapper FloatAsinOp = True
1838 primOpNeedsWrapper FloatAcosOp = True
1839 primOpNeedsWrapper FloatAtanOp = True
1840 primOpNeedsWrapper FloatSinhOp = True
1841 primOpNeedsWrapper FloatCoshOp = True
1842 primOpNeedsWrapper FloatTanhOp = True
1843 primOpNeedsWrapper FloatPowerOp = True
1844 primOpNeedsWrapper FloatEncodeOp = True
1846 primOpNeedsWrapper DoubleExpOp = True
1847 primOpNeedsWrapper DoubleLogOp = True
1848 primOpNeedsWrapper DoubleSqrtOp = True
1849 primOpNeedsWrapper DoubleSinOp = True
1850 primOpNeedsWrapper DoubleCosOp = True
1851 primOpNeedsWrapper DoubleTanOp = True
1852 primOpNeedsWrapper DoubleAsinOp = True
1853 primOpNeedsWrapper DoubleAcosOp = True
1854 primOpNeedsWrapper DoubleAtanOp = True
1855 primOpNeedsWrapper DoubleSinhOp = True
1856 primOpNeedsWrapper DoubleCoshOp = True
1857 primOpNeedsWrapper DoubleTanhOp = True
1858 primOpNeedsWrapper DoublePowerOp = True
1859 primOpNeedsWrapper DoubleEncodeOp = True
1861 primOpNeedsWrapper MakeStablePtrOp = True
1862 primOpNeedsWrapper DeRefStablePtrOp = True
1864 primOpNeedsWrapper DelayOp = True
1865 primOpNeedsWrapper WaitReadOp = True
1866 primOpNeedsWrapper WaitWriteOp = True
1868 primOpNeedsWrapper other_op = False
1873 = case (primOpInfo op) of
1875 Monadic str _ -> str
1876 Compare str _ -> str
1877 GenPrimOp str _ _ _ -> str
1881 primOpUniq :: PrimOp -> Unique
1882 primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
1884 primOpType :: PrimOp -> Type
1886 = case (primOpInfo op) of
1887 Dyadic str ty -> dyadic_fun_ty ty
1888 Monadic str ty -> monadic_fun_ty ty
1889 Compare str ty -> compare_fun_ty ty
1891 GenPrimOp str tyvars arg_tys res_ty ->
1892 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
1896 data PrimOpResultInfo
1897 = ReturnsPrim PrimRep
1900 -- Some PrimOps need not return a manifest primitive or algebraic value
1901 -- (i.e. they might return a polymorphic value). These PrimOps *must*
1902 -- be out of line, or the code generator won't work.
1904 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1906 getPrimOpResultInfo op
1907 = case (primOpInfo op) of
1908 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1909 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1910 Compare _ ty -> ReturnsAlg boolTyCon
1911 GenPrimOp _ _ _ ty ->
1912 let rep = typePrimRep ty in
1914 PtrRep -> case splitAlgTyConApp_maybe ty of
1915 Nothing -> panic "getPrimOpResultInfo"
1916 Just (tc,_,_) -> ReturnsAlg tc
1917 other -> ReturnsPrim other
1919 isCompareOp :: PrimOp -> Bool
1922 = case primOpInfo op of
1927 The commutable ops are those for which we will try to move constants
1928 to the right hand side for strength reduction.
1931 commutableOp :: PrimOp -> Bool
1933 commutableOp CharEqOp = True
1934 commutableOp CharNeOp = True
1935 commutableOp IntAddOp = True
1936 commutableOp IntMulOp = True
1937 commutableOp AndOp = True
1938 commutableOp OrOp = True
1939 commutableOp XorOp = True
1940 commutableOp IntEqOp = True
1941 commutableOp IntNeOp = True
1942 commutableOp IntegerAddOp = True
1943 commutableOp IntegerMulOp = True
1944 commutableOp IntegerGcdOp = True
1945 commutableOp FloatAddOp = True
1946 commutableOp FloatMulOp = True
1947 commutableOp FloatEqOp = True
1948 commutableOp FloatNeOp = True
1949 commutableOp DoubleAddOp = True
1950 commutableOp DoubleMulOp = True
1951 commutableOp DoubleEqOp = True
1952 commutableOp DoubleNeOp = True
1953 commutableOp _ = False
1958 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1959 monadic_fun_ty ty = mkFunTy ty ty
1960 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1965 pprPrimOp :: PrimOp -> SDoc
1967 pprPrimOp (CCallOp fun is_casm may_gc cconv)
1969 callconv = text "{-" <> pprCallConv cconv <> text "-}"
1972 | is_casm && may_gc = "__casm_GC ``"
1973 | is_casm = "__casm ``"
1974 | may_gc = "__ccall_GC "
1975 | otherwise = "__ccall "
1978 | is_casm = text "''"
1983 Right _ -> ptext SLIT("<dynamic>")
1987 hcat [ ifPprDebug callconv
1988 , text before , ppr_fun , after]
1991 = getPprStyle $ \ sty ->
1992 if codeStyle sty then -- For C just print the primop itself
1994 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1995 ptext SLIT("PrelGHC.") <> ptext str
1996 else -- Unqualified is good enough
1999 str = primOpStr other_op