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, primOpOcc,
15 primOpOutOfLine, primOpNeedsWrapper,
16 primOpOkForSpeculation, primOpIsCheap,
19 getPrimOpResultInfo, PrimOpResultInfo(..),
24 #include "HsVersions.h"
26 import PrimRep -- most of it
31 import CallConv ( CallConv, pprCallConv )
32 import PprType ( pprParendType )
33 import OccName ( OccName, pprOccName, varOcc )
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 generate a 'typedef' to cast
185 -- the function pointer if compiling the ccall# down to
186 -- .hc code - can't do this inline for tedious reasons.)
188 Bool -- True <=> really a "casm"
189 Bool -- True <=> might invoke Haskell GC
190 CallConv -- calling convention to use.
192 -- (... to be continued ... )
195 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
196 (See @primOpInfo@ for details.)
198 Note: that first arg and part of the result should be the system state
199 token (which we carry around to fool over-zealous optimisers) but
200 which isn't actually passed.
202 For example, we represent
204 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
210 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
211 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
215 (AlgAlts [ ( FloatPrimAndIoWorld,
217 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
223 Nota Bene: there are some people who find the empty list of types in
224 the @Prim@ somewhat puzzling and would represent the above by
228 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
229 -- :: /\ alpha1, alpha2 alpha3, alpha4.
230 -- alpha1 -> alpha2 -> alpha3 -> alpha4
231 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
234 (AlgAlts [ ( FloatPrimAndIoWorld,
236 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
242 But, this is a completely different way of using @CCallOp@. The most
243 major changes required if we switch to this are in @primOpInfo@, and
244 the desugarer. The major difficulty is in moving the HeapRequirement
245 stuff somewhere appropriate. (The advantage is that we could simplify
246 @CCallOp@ and record just the number of arguments with corresponding
247 simplifications in reading pragma unfoldings, the simplifier,
248 instantiation (etc) of core expressions, ... . Maybe we should think
249 about using it this way?? ADR)
252 -- (... continued from above ... )
254 -- Operation to test two closure addresses for equality (yes really!)
255 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
256 | ReallyUnsafePtrEqualityOp
269 | ParGlobalOp -- named global par
270 | ParLocalOp -- named local par
271 | ParAtOp -- specifies destination of local par
272 | ParAtAbsOp -- specifies destination of local par (abs processor)
273 | ParAtRelOp -- specifies destination of local par (rel processor)
274 | ParAtForNowOp -- specifies initial destination of global par
275 | CopyableOp -- marks copyable code
276 | NoFollowOp -- marks non-followup expression
279 Used for the Ord instance
282 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
283 tagOf_PrimOp CharGeOp = ILIT( 2)
284 tagOf_PrimOp CharEqOp = ILIT( 3)
285 tagOf_PrimOp CharNeOp = ILIT( 4)
286 tagOf_PrimOp CharLtOp = ILIT( 5)
287 tagOf_PrimOp CharLeOp = ILIT( 6)
288 tagOf_PrimOp IntGtOp = ILIT( 7)
289 tagOf_PrimOp IntGeOp = ILIT( 8)
290 tagOf_PrimOp IntEqOp = ILIT( 9)
291 tagOf_PrimOp IntNeOp = ILIT( 10)
292 tagOf_PrimOp IntLtOp = ILIT( 11)
293 tagOf_PrimOp IntLeOp = ILIT( 12)
294 tagOf_PrimOp WordGtOp = ILIT( 13)
295 tagOf_PrimOp WordGeOp = ILIT( 14)
296 tagOf_PrimOp WordEqOp = ILIT( 15)
297 tagOf_PrimOp WordNeOp = ILIT( 16)
298 tagOf_PrimOp WordLtOp = ILIT( 17)
299 tagOf_PrimOp WordLeOp = ILIT( 18)
300 tagOf_PrimOp AddrGtOp = ILIT( 19)
301 tagOf_PrimOp AddrGeOp = ILIT( 20)
302 tagOf_PrimOp AddrEqOp = ILIT( 21)
303 tagOf_PrimOp AddrNeOp = ILIT( 22)
304 tagOf_PrimOp AddrLtOp = ILIT( 23)
305 tagOf_PrimOp AddrLeOp = ILIT( 24)
306 tagOf_PrimOp FloatGtOp = ILIT( 25)
307 tagOf_PrimOp FloatGeOp = ILIT( 26)
308 tagOf_PrimOp FloatEqOp = ILIT( 27)
309 tagOf_PrimOp FloatNeOp = ILIT( 28)
310 tagOf_PrimOp FloatLtOp = ILIT( 29)
311 tagOf_PrimOp FloatLeOp = ILIT( 30)
312 tagOf_PrimOp DoubleGtOp = ILIT( 31)
313 tagOf_PrimOp DoubleGeOp = ILIT( 32)
314 tagOf_PrimOp DoubleEqOp = ILIT( 33)
315 tagOf_PrimOp DoubleNeOp = ILIT( 34)
316 tagOf_PrimOp DoubleLtOp = ILIT( 35)
317 tagOf_PrimOp DoubleLeOp = ILIT( 36)
318 tagOf_PrimOp OrdOp = ILIT( 37)
319 tagOf_PrimOp ChrOp = ILIT( 38)
320 tagOf_PrimOp IntAddOp = ILIT( 39)
321 tagOf_PrimOp IntSubOp = ILIT( 40)
322 tagOf_PrimOp IntMulOp = ILIT( 41)
323 tagOf_PrimOp IntQuotOp = ILIT( 42)
324 tagOf_PrimOp IntRemOp = ILIT( 43)
325 tagOf_PrimOp IntNegOp = ILIT( 44)
326 tagOf_PrimOp IntAbsOp = ILIT( 45)
327 tagOf_PrimOp WordQuotOp = ILIT( 46)
328 tagOf_PrimOp WordRemOp = ILIT( 47)
329 tagOf_PrimOp AndOp = ILIT( 48)
330 tagOf_PrimOp OrOp = ILIT( 49)
331 tagOf_PrimOp NotOp = ILIT( 50)
332 tagOf_PrimOp XorOp = ILIT( 51)
333 tagOf_PrimOp SllOp = ILIT( 52)
334 tagOf_PrimOp SrlOp = ILIT( 53)
335 tagOf_PrimOp ISllOp = ILIT( 54)
336 tagOf_PrimOp ISraOp = ILIT( 55)
337 tagOf_PrimOp ISrlOp = ILIT( 56)
338 tagOf_PrimOp Int2WordOp = ILIT( 57)
339 tagOf_PrimOp Word2IntOp = ILIT( 58)
340 tagOf_PrimOp Int2AddrOp = ILIT( 59)
341 tagOf_PrimOp Addr2IntOp = ILIT( 60)
343 tagOf_PrimOp FloatAddOp = ILIT( 61)
344 tagOf_PrimOp FloatSubOp = ILIT( 62)
345 tagOf_PrimOp FloatMulOp = ILIT( 63)
346 tagOf_PrimOp FloatDivOp = ILIT( 64)
347 tagOf_PrimOp FloatNegOp = ILIT( 65)
348 tagOf_PrimOp Float2IntOp = ILIT( 66)
349 tagOf_PrimOp Int2FloatOp = ILIT( 67)
350 tagOf_PrimOp FloatExpOp = ILIT( 68)
351 tagOf_PrimOp FloatLogOp = ILIT( 69)
352 tagOf_PrimOp FloatSqrtOp = ILIT( 70)
353 tagOf_PrimOp FloatSinOp = ILIT( 71)
354 tagOf_PrimOp FloatCosOp = ILIT( 72)
355 tagOf_PrimOp FloatTanOp = ILIT( 73)
356 tagOf_PrimOp FloatAsinOp = ILIT( 74)
357 tagOf_PrimOp FloatAcosOp = ILIT( 75)
358 tagOf_PrimOp FloatAtanOp = ILIT( 76)
359 tagOf_PrimOp FloatSinhOp = ILIT( 77)
360 tagOf_PrimOp FloatCoshOp = ILIT( 78)
361 tagOf_PrimOp FloatTanhOp = ILIT( 79)
362 tagOf_PrimOp FloatPowerOp = ILIT( 80)
364 tagOf_PrimOp DoubleAddOp = ILIT( 81)
365 tagOf_PrimOp DoubleSubOp = ILIT( 82)
366 tagOf_PrimOp DoubleMulOp = ILIT( 83)
367 tagOf_PrimOp DoubleDivOp = ILIT( 84)
368 tagOf_PrimOp DoubleNegOp = ILIT( 85)
369 tagOf_PrimOp Double2IntOp = ILIT( 86)
370 tagOf_PrimOp Int2DoubleOp = ILIT( 87)
371 tagOf_PrimOp Double2FloatOp = ILIT( 88)
372 tagOf_PrimOp Float2DoubleOp = ILIT( 89)
373 tagOf_PrimOp DoubleExpOp = ILIT( 90)
374 tagOf_PrimOp DoubleLogOp = ILIT( 91)
375 tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
376 tagOf_PrimOp DoubleSinOp = ILIT( 93)
377 tagOf_PrimOp DoubleCosOp = ILIT( 94)
378 tagOf_PrimOp DoubleTanOp = ILIT( 95)
379 tagOf_PrimOp DoubleAsinOp = ILIT( 96)
380 tagOf_PrimOp DoubleAcosOp = ILIT( 97)
381 tagOf_PrimOp DoubleAtanOp = ILIT( 98)
382 tagOf_PrimOp DoubleSinhOp = ILIT( 99)
383 tagOf_PrimOp DoubleCoshOp = ILIT(100)
384 tagOf_PrimOp DoubleTanhOp = ILIT(101)
385 tagOf_PrimOp DoublePowerOp = ILIT(102)
387 tagOf_PrimOp IntegerAddOp = ILIT(103)
388 tagOf_PrimOp IntegerSubOp = ILIT(104)
389 tagOf_PrimOp IntegerMulOp = ILIT(105)
390 tagOf_PrimOp IntegerGcdOp = ILIT(106)
391 tagOf_PrimOp IntegerQuotRemOp = ILIT(107)
392 tagOf_PrimOp IntegerDivModOp = ILIT(108)
393 tagOf_PrimOp IntegerNegOp = ILIT(109)
394 tagOf_PrimOp IntegerCmpOp = ILIT(110)
395 tagOf_PrimOp Integer2IntOp = ILIT(111)
396 tagOf_PrimOp Integer2WordOp = ILIT(112)
397 tagOf_PrimOp Int2IntegerOp = ILIT(113)
398 tagOf_PrimOp Word2IntegerOp = ILIT(114)
399 tagOf_PrimOp Addr2IntegerOp = ILIT(115)
400 tagOf_PrimOp IntegerToInt64Op = ILIT(116)
401 tagOf_PrimOp Int64ToIntegerOp = ILIT(117)
402 tagOf_PrimOp IntegerToWord64Op = ILIT(118)
403 tagOf_PrimOp Word64ToIntegerOp = ILIT(119)
405 tagOf_PrimOp FloatEncodeOp = ILIT(120)
406 tagOf_PrimOp FloatDecodeOp = ILIT(121)
407 tagOf_PrimOp DoubleEncodeOp = ILIT(122)
408 tagOf_PrimOp DoubleDecodeOp = ILIT(123)
410 tagOf_PrimOp NewArrayOp = ILIT(124)
411 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(125)
412 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(126)
413 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(127)
414 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(128)
415 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(129)
416 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(130)
417 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(131)
418 tagOf_PrimOp SameMutableArrayOp = ILIT(132)
419 tagOf_PrimOp SameMutableByteArrayOp = ILIT(133)
420 tagOf_PrimOp ReadArrayOp = ILIT(134)
421 tagOf_PrimOp WriteArrayOp = ILIT(135)
422 tagOf_PrimOp IndexArrayOp = ILIT(136)
424 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(137)
425 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(138)
426 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(139)
427 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(140)
428 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(141)
429 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(142)
430 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(143)
431 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(144)
432 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(145)
434 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(146)
435 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147)
436 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148)
437 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(149)
438 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(150)
439 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(151)
440 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(152)
441 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(153)
442 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(154)
444 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(155)
445 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(156)
446 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(157)
447 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(158)
448 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(159)
449 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(160)
450 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(161)
451 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(162)
452 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(163)
454 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(164)
455 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(165)
456 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(166)
457 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(167)
458 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(168)
459 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(169)
460 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(170)
461 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(171)
462 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(172)
463 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(173)
464 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(174)
465 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(175)
466 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(176)
467 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(177)
468 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(178)
469 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(179)
470 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(180)
471 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(181)
473 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(182)
474 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(183)
475 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(184)
476 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(185)
477 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(186)
478 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(187)
479 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(188)
480 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(189)
481 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(190)
482 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(191)
484 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(192)
485 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(193)
486 tagOf_PrimOp SizeofByteArrayOp = ILIT(194)
487 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(195)
488 tagOf_PrimOp NewMVarOp = ILIT(196)
489 tagOf_PrimOp TakeMVarOp = ILIT(197)
490 tagOf_PrimOp PutMVarOp = ILIT(198)
491 tagOf_PrimOp SameMVarOp = ILIT(199)
492 tagOf_PrimOp MakeForeignObjOp = ILIT(200)
493 tagOf_PrimOp WriteForeignObjOp = ILIT(201)
494 tagOf_PrimOp MkWeakOp = ILIT(202)
495 tagOf_PrimOp DeRefWeakOp = ILIT(203)
496 tagOf_PrimOp MakeStablePtrOp = ILIT(204)
497 tagOf_PrimOp DeRefStablePtrOp = ILIT(205)
498 tagOf_PrimOp EqStablePtrOp = ILIT(206)
499 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(207)
500 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(208)
501 tagOf_PrimOp SeqOp = ILIT(209)
502 tagOf_PrimOp ParOp = ILIT(210)
503 tagOf_PrimOp ForkOp = ILIT(211)
504 tagOf_PrimOp KillThreadOp = ILIT(212)
505 tagOf_PrimOp DelayOp = ILIT(213)
506 tagOf_PrimOp WaitReadOp = ILIT(214)
507 tagOf_PrimOp WaitWriteOp = ILIT(215)
508 tagOf_PrimOp ParGlobalOp = ILIT(216)
509 tagOf_PrimOp ParLocalOp = ILIT(217)
510 tagOf_PrimOp ParAtOp = ILIT(218)
511 tagOf_PrimOp ParAtAbsOp = ILIT(219)
512 tagOf_PrimOp ParAtRelOp = ILIT(220)
513 tagOf_PrimOp ParAtForNowOp = ILIT(221)
514 tagOf_PrimOp CopyableOp = ILIT(222)
515 tagOf_PrimOp NoFollowOp = ILIT(223)
516 tagOf_PrimOp NewMutVarOp = ILIT(224)
517 tagOf_PrimOp ReadMutVarOp = ILIT(225)
518 tagOf_PrimOp WriteMutVarOp = ILIT(226)
519 tagOf_PrimOp SameMutVarOp = ILIT(227)
520 tagOf_PrimOp CatchOp = ILIT(228)
521 tagOf_PrimOp RaiseOp = ILIT(229)
523 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
524 --panic# "tagOf_PrimOp: pattern-match"
526 instance Eq PrimOp where
527 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
529 instance Ord PrimOp where
530 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
531 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
532 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
533 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
534 op1 `compare` op2 | op1 < op2 = LT
538 instance Outputable PrimOp where
539 ppr op = pprPrimOp op
541 instance Show PrimOp where
542 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
545 An @Enum@-derived list would be better; meanwhile... (ToDo)
672 NewByteArrayOp CharRep,
673 NewByteArrayOp IntRep,
674 NewByteArrayOp WordRep,
675 NewByteArrayOp AddrRep,
676 NewByteArrayOp FloatRep,
677 NewByteArrayOp DoubleRep,
678 NewByteArrayOp StablePtrRep,
680 SameMutableByteArrayOp,
684 ReadByteArrayOp CharRep,
685 ReadByteArrayOp IntRep,
686 ReadByteArrayOp WordRep,
687 ReadByteArrayOp AddrRep,
688 ReadByteArrayOp FloatRep,
689 ReadByteArrayOp DoubleRep,
690 ReadByteArrayOp StablePtrRep,
691 ReadByteArrayOp Int64Rep,
692 ReadByteArrayOp Word64Rep,
693 WriteByteArrayOp CharRep,
694 WriteByteArrayOp IntRep,
695 WriteByteArrayOp WordRep,
696 WriteByteArrayOp AddrRep,
697 WriteByteArrayOp FloatRep,
698 WriteByteArrayOp DoubleRep,
699 WriteByteArrayOp StablePtrRep,
700 WriteByteArrayOp Int64Rep,
701 WriteByteArrayOp Word64Rep,
702 IndexByteArrayOp CharRep,
703 IndexByteArrayOp IntRep,
704 IndexByteArrayOp WordRep,
705 IndexByteArrayOp AddrRep,
706 IndexByteArrayOp FloatRep,
707 IndexByteArrayOp DoubleRep,
708 IndexByteArrayOp StablePtrRep,
709 IndexByteArrayOp Int64Rep,
710 IndexByteArrayOp Word64Rep,
711 IndexOffForeignObjOp CharRep,
712 IndexOffForeignObjOp AddrRep,
713 IndexOffForeignObjOp IntRep,
714 IndexOffForeignObjOp WordRep,
715 IndexOffForeignObjOp FloatRep,
716 IndexOffForeignObjOp DoubleRep,
717 IndexOffForeignObjOp StablePtrRep,
718 IndexOffForeignObjOp Int64Rep,
719 IndexOffForeignObjOp Word64Rep,
720 IndexOffAddrOp CharRep,
721 IndexOffAddrOp IntRep,
722 IndexOffAddrOp WordRep,
723 IndexOffAddrOp AddrRep,
724 IndexOffAddrOp FloatRep,
725 IndexOffAddrOp DoubleRep,
726 IndexOffAddrOp StablePtrRep,
727 IndexOffAddrOp Int64Rep,
728 IndexOffAddrOp Word64Rep,
729 WriteOffAddrOp CharRep,
730 WriteOffAddrOp IntRep,
731 WriteOffAddrOp WordRep,
732 WriteOffAddrOp AddrRep,
733 WriteOffAddrOp FloatRep,
734 WriteOffAddrOp DoubleRep,
735 WriteOffAddrOp ForeignObjRep,
736 WriteOffAddrOp StablePtrRep,
737 WriteOffAddrOp Int64Rep,
738 WriteOffAddrOp Word64Rep,
740 UnsafeFreezeByteArrayOp,
742 SizeofMutableByteArrayOp,
760 ReallyUnsafePtrEqualityOp,
779 %************************************************************************
781 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
783 %************************************************************************
785 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
786 refer to the primitive operation. The conventional \tr{#}-for-
787 unboxed ops is added on later.
789 The reason for the funny characters in the names is so we do not
790 interfere with the programmer's Haskell name spaces.
792 We use @PrimKinds@ for the ``type'' information, because they're
793 (slightly) more convenient to use than @TyCons@.
796 = Dyadic OccName -- string :: T -> T -> T
798 | Monadic OccName -- string :: T -> T
800 | Compare OccName -- string :: T -> T -> Bool
803 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
808 mkDyadic str ty = Dyadic (varOcc str) ty
809 mkMonadic str ty = Monadic (varOcc str) ty
810 mkCompare str ty = Compare (varOcc str) ty
811 mkGenPrimOp str tvs tys ty = GenPrimOp (varOcc str) tvs tys ty
816 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
818 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
819 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
820 an_Integer_and_Int_tys
821 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
824 unboxedPair = mkUnboxedTupleTy 2
825 unboxedTriple = mkUnboxedTupleTy 3
826 unboxedQuadruple = mkUnboxedTupleTy 4
827 unboxedSexTuple = mkUnboxedTupleTy 6
829 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
830 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
832 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
833 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
835 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
836 (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy,
837 intPrimTy, intPrimTy, byteArrayPrimTy])
839 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
842 %************************************************************************
844 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
846 %************************************************************************
848 @primOpInfo@ gives all essential information (from which everything
849 else, notably a type, can be constructed) for each @PrimOp@.
852 primOpInfo :: PrimOp -> PrimOpInfo
855 There's plenty of this stuff!
858 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
859 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
860 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
861 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
862 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
863 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
865 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
866 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
867 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
868 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
869 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
870 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
872 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
873 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
874 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
875 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
876 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
877 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
879 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
880 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
881 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
882 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
883 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
884 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
886 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
887 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
888 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
889 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
890 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
891 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
893 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
894 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
895 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
896 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
897 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
898 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
902 %************************************************************************
904 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
906 %************************************************************************
909 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
910 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
913 %************************************************************************
915 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
917 %************************************************************************
920 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
921 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
922 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
923 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
924 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
926 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
927 primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
930 %************************************************************************
932 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
934 %************************************************************************
936 A @Word#@ is an unsigned @Int#@.
939 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
940 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
942 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
943 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
944 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
945 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
948 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
950 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
953 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
955 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
957 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
959 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
960 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
963 %************************************************************************
965 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
967 %************************************************************************
970 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
971 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
975 %************************************************************************
977 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
979 %************************************************************************
981 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
985 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
986 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
987 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
988 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
989 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
991 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
992 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
994 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
995 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
996 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
997 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
998 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
999 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
1000 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
1001 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
1002 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
1003 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
1004 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
1005 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
1006 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
1009 %************************************************************************
1011 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
1013 %************************************************************************
1015 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
1019 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
1020 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
1021 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
1022 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
1023 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
1025 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
1026 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
1028 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
1029 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
1031 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
1032 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
1033 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
1034 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
1035 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
1036 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
1037 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
1038 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
1039 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
1040 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
1041 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
1042 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
1043 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
1046 %************************************************************************
1048 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1050 %************************************************************************
1053 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1055 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1056 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1057 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1058 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
1060 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1062 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1063 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1065 primOpInfo Integer2IntOp
1066 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
1068 primOpInfo Integer2WordOp
1069 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
1071 primOpInfo Int2IntegerOp
1072 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
1073 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1075 primOpInfo Word2IntegerOp
1076 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
1077 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1079 primOpInfo Addr2IntegerOp
1080 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
1081 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1083 primOpInfo IntegerToInt64Op
1084 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
1086 primOpInfo Int64ToIntegerOp
1087 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
1088 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1090 primOpInfo Word64ToIntegerOp
1091 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
1092 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
1094 primOpInfo IntegerToWord64Op
1095 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
1098 Encoding and decoding of floating-point numbers is sorta
1102 primOpInfo FloatEncodeOp
1103 = mkGenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy
1105 primOpInfo DoubleEncodeOp
1106 = mkGenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy
1108 primOpInfo FloatDecodeOp
1109 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
1110 (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
1111 primOpInfo DoubleDecodeOp
1112 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
1113 (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy])
1116 %************************************************************************
1118 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1120 %************************************************************************
1123 primOpInfo NewArrayOp
1125 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1126 state = mkStatePrimTy s
1128 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
1129 [intPrimTy, elt, state]
1130 (unboxedPair [state, mkMutableArrayPrimTy s elt])
1132 primOpInfo (NewByteArrayOp kind)
1134 s = alphaTy; s_tv = alphaTyVar
1136 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
1137 state = mkStatePrimTy s
1139 mkGenPrimOp op_str [s_tv]
1141 (unboxedPair [state, mkMutableByteArrayPrimTy s])
1143 ---------------------------------------------------------------------------
1145 primOpInfo SameMutableArrayOp
1147 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1148 mut_arr_ty = mkMutableArrayPrimTy s elt
1150 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1153 primOpInfo SameMutableByteArrayOp
1155 s = alphaTy; s_tv = alphaTyVar;
1156 mut_arr_ty = mkMutableByteArrayPrimTy s
1158 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1161 ---------------------------------------------------------------------------
1162 -- Primitive arrays of Haskell pointers:
1164 primOpInfo ReadArrayOp
1166 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1167 state = mkStatePrimTy s
1169 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
1170 [mkMutableArrayPrimTy s elt, intPrimTy, state]
1171 (unboxedPair [state, elt])
1174 primOpInfo WriteArrayOp
1176 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1178 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
1179 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1182 primOpInfo IndexArrayOp
1183 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1184 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1185 (unboxedPair [realWorldStatePrimTy, elt])
1187 ---------------------------------------------------------------------------
1188 -- Primitive arrays full of unboxed bytes:
1190 primOpInfo (ReadByteArrayOp kind)
1192 s = alphaTy; s_tv = alphaTyVar
1194 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
1195 relevant_type = assoc "primOpInfo{ReadByteArrayOp}" tbl kind
1196 state = mkStatePrimTy s
1199 | kind == StablePtrRep = [s_tv, betaTyVar]
1200 | otherwise = [s_tv]
1202 mkGenPrimOp op_str tvs
1203 [mkMutableByteArrayPrimTy s, intPrimTy, state]
1204 (unboxedPair [state, relevant_type])
1206 tbl = [ (CharRep, charPrimTy),
1207 (IntRep, intPrimTy),
1208 (WordRep, wordPrimTy),
1209 (AddrRep, addrPrimTy),
1210 (FloatRep, floatPrimTy),
1211 (StablePtrRep, mkStablePtrPrimTy betaTy),
1212 (DoubleRep, doublePrimTy) ]
1214 -- How come there's no Word byte arrays? ADR
1216 primOpInfo (WriteByteArrayOp kind)
1218 s = alphaTy; s_tv = alphaTyVar
1219 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
1220 prim_ty = mkTyConApp (primRepTyCon kind) []
1223 | kind == StablePtrRep = (mkStablePtrPrimTy betaTy, [s_tv, betaTyVar])
1224 | otherwise = (prim_ty, [s_tv])
1227 mkGenPrimOp op_str tvs
1228 [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
1231 primOpInfo (IndexByteArrayOp kind)
1233 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
1235 (prim_tycon_args, tvs)
1236 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1237 | otherwise = ([],[])
1239 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy]
1240 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1242 primOpInfo (IndexOffForeignObjOp kind)
1244 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
1246 (prim_tycon_args, tvs)
1247 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1248 | otherwise = ([], [])
1250 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy]
1251 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1253 primOpInfo (IndexOffAddrOp kind)
1255 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
1257 (prim_tycon_args, tvs)
1258 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1259 | otherwise = ([], [])
1261 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy]
1262 (mkTyConApp (primRepTyCon kind) prim_tycon_args)
1264 primOpInfo (WriteOffAddrOp kind)
1266 s = alphaTy; s_tv = alphaTyVar
1267 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
1268 prim_ty = mkTyConApp (primRepTyCon kind) []
1270 mkGenPrimOp op_str [s_tv]
1271 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1274 ---------------------------------------------------------------------------
1275 primOpInfo UnsafeFreezeArrayOp
1277 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1278 state = mkStatePrimTy s
1280 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1281 [mkMutableArrayPrimTy s elt, state]
1282 (unboxedPair [state, mkArrayPrimTy elt])
1284 primOpInfo UnsafeFreezeByteArrayOp
1286 s = alphaTy; s_tv = alphaTyVar;
1287 state = mkStatePrimTy s
1289 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
1290 [mkMutableByteArrayPrimTy s, state]
1291 (unboxedPair [state, byteArrayPrimTy])
1293 ---------------------------------------------------------------------------
1294 primOpInfo SizeofByteArrayOp
1296 SLIT("sizeofByteArray#") []
1300 primOpInfo SizeofMutableByteArrayOp
1301 = let { s = alphaTy; s_tv = alphaTyVar } in
1303 SLIT("sizeofMutableByteArray#") [s_tv]
1304 [mkMutableByteArrayPrimTy s]
1309 %************************************************************************
1311 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
1313 %************************************************************************
1316 primOpInfo NewMutVarOp
1318 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1319 state = mkStatePrimTy s
1321 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
1323 (unboxedPair [state, mkMutVarPrimTy s elt])
1325 primOpInfo ReadMutVarOp
1327 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1328 state = mkStatePrimTy s
1330 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
1331 [mkMutVarPrimTy s elt, state]
1332 (unboxedPair [state, elt])
1335 primOpInfo WriteMutVarOp
1337 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1339 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
1340 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
1343 primOpInfo SameMutVarOp
1345 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1346 mut_var_ty = mkMutVarPrimTy s elt
1348 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
1352 %************************************************************************
1354 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
1356 %************************************************************************
1358 catch :: IO a -> (IOError -> IO a) -> IO a
1359 catch :: a -> (b -> a) -> a
1364 a = alphaTy; a_tv = alphaTyVar;
1365 b = betaTy; b_tv = betaTyVar;
1367 mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
1371 a = alphaTy; a_tv = alphaTyVar;
1372 b = betaTy; b_tv = betaTyVar;
1374 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
1377 %************************************************************************
1379 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
1381 %************************************************************************
1384 primOpInfo NewMVarOp
1386 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1387 state = mkStatePrimTy s
1389 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
1390 (unboxedPair [state, mkMVarPrimTy s elt])
1392 primOpInfo TakeMVarOp
1394 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1395 state = mkStatePrimTy s
1397 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
1398 [mkMVarPrimTy s elt, state]
1399 (unboxedPair [state, elt])
1401 primOpInfo PutMVarOp
1403 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1405 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
1406 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
1409 primOpInfo SameMVarOp
1411 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1412 mvar_ty = mkMVarPrimTy s elt
1414 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
1417 %************************************************************************
1419 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1421 %************************************************************************
1427 s = alphaTy; s_tv = alphaTyVar
1429 mkGenPrimOp SLIT("delay#") [s_tv]
1430 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1432 primOpInfo WaitReadOp
1434 s = alphaTy; s_tv = alphaTyVar
1436 mkGenPrimOp SLIT("waitRead#") [s_tv]
1437 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1439 primOpInfo WaitWriteOp
1441 s = alphaTy; s_tv = alphaTyVar
1443 mkGenPrimOp SLIT("waitWrite#") [s_tv]
1444 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1447 %************************************************************************
1449 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
1451 %************************************************************************
1454 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
1456 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
1457 [alphaTy, realWorldStatePrimTy]
1458 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
1460 -- killThread# :: ThreadId# -> State# RealWorld -> State# RealWorld
1461 primOpInfo KillThreadOp
1462 = mkGenPrimOp SLIT("killThread#") []
1463 [threadIdPrimTy, realWorldStatePrimTy]
1464 realWorldStatePrimTy
1467 ************************************************************************
1469 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
1471 %************************************************************************
1474 primOpInfo MakeForeignObjOp
1475 = mkGenPrimOp SLIT("makeForeignObj#") []
1476 [addrPrimTy, realWorldStatePrimTy]
1477 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
1479 primOpInfo WriteForeignObjOp
1481 s = alphaTy; s_tv = alphaTyVar
1483 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
1484 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
1487 ************************************************************************
1489 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
1491 %************************************************************************
1493 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
1495 mkWeak# :: k -> v -> f -> State# RealWorld
1496 -> (# State# RealWorld, Weak# v #)
1498 In practice, you'll use the higher-level
1500 data Weak v = Weak# v
1501 mkWeak :: k -> v -> IO () -> IO (Weak v)
1505 = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
1506 [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
1507 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
1510 The following operation dereferences a weak pointer. The weak pointer
1511 may have been finalised, so the operation returns a result code which
1512 must be inspected before looking at the dereferenced value.
1514 deRefWeak# :: Weak# v -> State# RealWorld ->
1515 (# State# RealWorld, v, Int# #)
1517 Only look at v if the Int# returned is /= 0 !!
1519 The higher-level op is
1521 deRefWeak :: Weak v -> IO (Maybe v)
1524 primOpInfo DeRefWeakOp
1525 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
1526 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
1527 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
1530 %************************************************************************
1532 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1534 %************************************************************************
1536 A {\em stable pointer} is an index into a table of pointers into the
1537 heap. Since the garbage collector is told about stable pointers, it
1538 is safe to pass a stable pointer to external systems such as C
1541 Here's what the operations and types are supposed to be (from
1542 state-interface document).
1545 makeStablePtr# :: a -> State# _RealWorld -> (# State# _RealWorld, a #)
1546 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1547 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> (# State# _RealWorld, a #)
1548 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
1551 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1552 operation since it doesn't (directly) involve IO operations. The
1553 reason is that if some optimisation pass decided to duplicate calls to
1554 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1555 massive space leak can result. Putting it into the PrimIO monad
1556 prevents this. (Another reason for putting them in a monad is to
1557 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1560 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1561 besides, it's not likely to be used from Haskell) so it's not a
1564 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1567 primOpInfo MakeStablePtrOp
1568 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
1569 [alphaTy, realWorldStatePrimTy]
1570 (unboxedPair [realWorldStatePrimTy,
1571 mkTyConApp stablePtrPrimTyCon [alphaTy]])
1573 primOpInfo DeRefStablePtrOp
1574 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
1575 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1576 (unboxedPair [realWorldStatePrimTy, alphaTy])
1578 primOpInfo EqStablePtrOp
1579 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
1580 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
1584 %************************************************************************
1586 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1588 %************************************************************************
1590 [Alastair Reid is to blame for this!]
1592 These days, (Glasgow) Haskell seems to have a bit of everything from
1593 other languages: strict operations, mutable variables, sequencing,
1594 pointers, etc. About the only thing left is LISP's ability to test
1595 for pointer equality. So, let's add it in!
1598 reallyUnsafePtrEquality :: a -> a -> Int#
1601 which tests any two closures (of the same type) to see if they're the
1602 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1603 difficulties of trying to box up the result.)
1605 NB This is {\em really unsafe\/} because even something as trivial as
1606 a garbage collection might change the answer by removing indirections.
1607 Still, no-one's forcing you to use it. If you're worried about little
1608 things like loss of referential transparency, you might like to wrap
1609 it all up in a monad-like thing as John O'Donnell and John Hughes did
1610 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1613 I'm thinking of using it to speed up a critical equality test in some
1614 graphics stuff in a context where the possibility of saying that
1615 denotationally equal things aren't isn't a problem (as long as it
1616 doesn't happen too often.) ADR
1618 To Will: Jim said this was already in, but I can't see it so I'm
1619 adding it. Up to you whether you add it. (Note that this could have
1620 been readily implemented using a @veryDangerousCCall@ before they were
1624 primOpInfo ReallyUnsafePtrEqualityOp
1625 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1626 [alphaTy, alphaTy] intPrimTy
1629 %************************************************************************
1631 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1633 %************************************************************************
1636 primOpInfo SeqOp -- seq# :: a -> Int#
1637 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
1639 primOpInfo ParOp -- par# :: a -> Int#
1640 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
1644 -- HWL: The first 4 Int# in all par... annotations denote:
1645 -- name, granularity info, size of result, degree of parallelism
1646 -- Same structure as _seq_ i.e. returns Int#
1648 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1649 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1651 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1652 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1654 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1655 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1657 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1658 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1660 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1661 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
1663 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1664 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
1666 primOpInfo CopyableOp -- copyable# :: a -> a
1667 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
1669 primOpInfo NoFollowOp -- noFollow# :: a -> a
1670 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
1673 %************************************************************************
1675 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1677 %************************************************************************
1680 primOpInfo (CCallOp _ _ _ _)
1681 = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
1684 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1685 = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
1687 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1690 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1694 Some PrimOps need to be called out-of-line because they either need to
1695 perform a heap check or they block.
1708 NewByteArrayOp _ -> True
1709 IntegerAddOp -> True
1710 IntegerSubOp -> True
1711 IntegerMulOp -> True
1712 IntegerGcdOp -> True
1713 IntegerQuotRemOp -> True
1714 IntegerDivModOp -> True
1715 Int2IntegerOp -> True
1716 Word2IntegerOp -> True
1717 Addr2IntegerOp -> True
1718 Word64ToIntegerOp -> True
1719 Int64ToIntegerOp -> True
1720 FloatDecodeOp -> True
1721 DoubleDecodeOp -> True
1724 MakeForeignObjOp -> True
1725 MakeStablePtrOp -> True
1729 KillThreadOp -> True
1730 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
1734 Sometimes we may choose to execute a PrimOp even though it isn't
1735 certain that its result will be required; ie execute them
1736 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1737 this is OK, because PrimOps are usually cheap, but it isn't OK for
1738 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1740 See also @primOpIsCheap@ (below).
1742 PrimOps that have side effects also should not be executed speculatively
1743 or by data dependencies.
1746 primOpOkForSpeculation :: PrimOp -> Bool
1747 primOpOkForSpeculation op
1748 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
1751 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1752 WARNING), we just borrow some other predicates for a
1753 what-should-be-good-enough test. "Cheap" means willing to call it more
1754 than once. Evaluation order is unaffected.
1757 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
1761 primOpCanFail :: PrimOp -> Bool
1763 primOpCanFail IntQuotOp = True -- Divide by zero
1764 primOpCanFail IntRemOp = True -- Divide by zero
1767 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
1768 primOpCanFail IntegerDivModOp = True -- Divide by zero
1770 -- Float. ToDo: tan? tanh?
1771 primOpCanFail FloatDivOp = True -- Divide by zero
1772 primOpCanFail FloatLogOp = True -- Log of zero
1773 primOpCanFail FloatAsinOp = True -- Arg out of domain
1774 primOpCanFail FloatAcosOp = True -- Arg out of domain
1776 -- Double. ToDo: tan? tanh?
1777 primOpCanFail DoubleDivOp = True -- Divide by zero
1778 primOpCanFail DoubleLogOp = True -- Log of zero
1779 primOpCanFail DoubleAsinOp = True -- Arg out of domain
1780 primOpCanFail DoubleAcosOp = True -- Arg out of domain
1782 primOpCanFail other_op = False
1785 And some primops have side-effects and so, for example, must not be
1789 primOpHasSideEffects :: PrimOp -> Bool
1791 primOpHasSideEffects TakeMVarOp = True
1792 primOpHasSideEffects DelayOp = True
1793 primOpHasSideEffects WaitReadOp = True
1794 primOpHasSideEffects WaitWriteOp = True
1796 primOpHasSideEffects ParOp = True
1797 primOpHasSideEffects ForkOp = True
1798 primOpHasSideEffects KillThreadOp = True
1799 primOpHasSideEffects SeqOp = True
1801 primOpHasSideEffects MakeForeignObjOp = True
1802 primOpHasSideEffects WriteForeignObjOp = True
1803 primOpHasSideEffects MkWeakOp = True
1804 primOpHasSideEffects DeRefWeakOp = True
1805 primOpHasSideEffects MakeStablePtrOp = True
1806 primOpHasSideEffects EqStablePtrOp = True -- SOF
1807 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
1809 primOpHasSideEffects ParGlobalOp = True
1810 primOpHasSideEffects ParLocalOp = True
1811 primOpHasSideEffects ParAtOp = True
1812 primOpHasSideEffects ParAtAbsOp = True
1813 primOpHasSideEffects ParAtRelOp = True
1814 primOpHasSideEffects ParAtForNowOp = True
1815 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
1816 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
1819 primOpHasSideEffects (CCallOp _ _ _ _) = True
1821 primOpHasSideEffects other = False
1824 Inline primitive operations that perform calls need wrappers to save
1825 any live variables that are stored in caller-saves registers.
1828 primOpNeedsWrapper :: PrimOp -> Bool
1830 primOpNeedsWrapper (CCallOp _ _ _ _) = True
1832 primOpNeedsWrapper Integer2IntOp = True
1833 primOpNeedsWrapper Integer2WordOp = True
1834 primOpNeedsWrapper IntegerCmpOp = True
1836 primOpNeedsWrapper FloatExpOp = True
1837 primOpNeedsWrapper FloatLogOp = True
1838 primOpNeedsWrapper FloatSqrtOp = True
1839 primOpNeedsWrapper FloatSinOp = True
1840 primOpNeedsWrapper FloatCosOp = True
1841 primOpNeedsWrapper FloatTanOp = True
1842 primOpNeedsWrapper FloatAsinOp = True
1843 primOpNeedsWrapper FloatAcosOp = True
1844 primOpNeedsWrapper FloatAtanOp = True
1845 primOpNeedsWrapper FloatSinhOp = True
1846 primOpNeedsWrapper FloatCoshOp = True
1847 primOpNeedsWrapper FloatTanhOp = True
1848 primOpNeedsWrapper FloatPowerOp = True
1849 primOpNeedsWrapper FloatEncodeOp = True
1851 primOpNeedsWrapper DoubleExpOp = True
1852 primOpNeedsWrapper DoubleLogOp = True
1853 primOpNeedsWrapper DoubleSqrtOp = True
1854 primOpNeedsWrapper DoubleSinOp = True
1855 primOpNeedsWrapper DoubleCosOp = True
1856 primOpNeedsWrapper DoubleTanOp = True
1857 primOpNeedsWrapper DoubleAsinOp = True
1858 primOpNeedsWrapper DoubleAcosOp = True
1859 primOpNeedsWrapper DoubleAtanOp = True
1860 primOpNeedsWrapper DoubleSinhOp = True
1861 primOpNeedsWrapper DoubleCoshOp = True
1862 primOpNeedsWrapper DoubleTanhOp = True
1863 primOpNeedsWrapper DoublePowerOp = True
1864 primOpNeedsWrapper DoubleEncodeOp = True
1866 primOpNeedsWrapper MakeStablePtrOp = True
1867 primOpNeedsWrapper DeRefStablePtrOp = True
1869 primOpNeedsWrapper DelayOp = True
1870 primOpNeedsWrapper WaitReadOp = True
1871 primOpNeedsWrapper WaitWriteOp = True
1873 primOpNeedsWrapper other_op = False
1878 = case (primOpInfo op) of
1880 Monadic occ _ -> occ
1881 Compare occ _ -> occ
1882 GenPrimOp occ _ _ _ -> occ
1886 primOpUniq :: PrimOp -> Unique
1887 primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
1889 primOpType :: PrimOp -> Type
1891 = case (primOpInfo op) of
1892 Dyadic occ ty -> dyadic_fun_ty ty
1893 Monadic occ ty -> monadic_fun_ty ty
1894 Compare occ ty -> compare_fun_ty ty
1896 GenPrimOp occ tyvars arg_tys res_ty ->
1897 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
1901 data PrimOpResultInfo
1902 = ReturnsPrim PrimRep
1905 -- Some PrimOps need not return a manifest primitive or algebraic value
1906 -- (i.e. they might return a polymorphic value). These PrimOps *must*
1907 -- be out of line, or the code generator won't work.
1909 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1911 getPrimOpResultInfo op
1912 = case (primOpInfo op) of
1913 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1914 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1915 Compare _ ty -> ReturnsAlg boolTyCon
1916 GenPrimOp _ _ _ ty ->
1917 let rep = typePrimRep ty in
1919 PtrRep -> case splitAlgTyConApp_maybe ty of
1920 Nothing -> panic "getPrimOpResultInfo"
1921 Just (tc,_,_) -> ReturnsAlg tc
1922 other -> ReturnsPrim other
1924 isCompareOp :: PrimOp -> Bool
1927 = case primOpInfo op of
1932 The commutable ops are those for which we will try to move constants
1933 to the right hand side for strength reduction.
1936 commutableOp :: PrimOp -> Bool
1938 commutableOp CharEqOp = True
1939 commutableOp CharNeOp = True
1940 commutableOp IntAddOp = True
1941 commutableOp IntMulOp = True
1942 commutableOp AndOp = True
1943 commutableOp OrOp = True
1944 commutableOp XorOp = True
1945 commutableOp IntEqOp = True
1946 commutableOp IntNeOp = True
1947 commutableOp IntegerAddOp = True
1948 commutableOp IntegerMulOp = True
1949 commutableOp IntegerGcdOp = True
1950 commutableOp FloatAddOp = True
1951 commutableOp FloatMulOp = True
1952 commutableOp FloatEqOp = True
1953 commutableOp FloatNeOp = True
1954 commutableOp DoubleAddOp = True
1955 commutableOp DoubleMulOp = True
1956 commutableOp DoubleEqOp = True
1957 commutableOp DoubleNeOp = True
1958 commutableOp _ = False
1963 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1964 monadic_fun_ty ty = mkFunTy ty ty
1965 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1970 pprPrimOp :: PrimOp -> SDoc
1972 pprPrimOp (CCallOp fun is_casm may_gc cconv)
1974 callconv = text "{-" <> pprCallConv cconv <> text "-}"
1977 | is_casm && may_gc = "__casm_GC ``"
1978 | is_casm = "__casm ``"
1979 | may_gc = "__ccall_GC "
1980 | otherwise = "__ccall "
1983 | is_casm = text "''"
1988 Right _ -> ptext SLIT("<dynamic>")
1992 hcat [ ifPprDebug callconv
1993 , text before , ppr_fun , after]
1996 = getPprStyle $ \ sty ->
1997 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1998 ptext SLIT("PrelGHC.") <> pprOccName occ
2002 occ = primOpOcc other_op