2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrimOp]{Primitive operations (machine-level)}
8 PrimOp(..), allThePrimOps,
9 tagOf_PrimOp, -- ToDo: rm
11 primOpType, isCompareOp,
17 primOpCanTriggerGC, primOpNeedsWrapper,
18 primOpOkForSpeculation, primOpIsCheap,
20 HeapRequirement(..), primOpHeapReq,
21 StackRequirement(..), primOpStackRequired,
23 -- export for the Native Code Generator
24 primOpInfo, -- needed for primOpNameInfo
30 #include "HsVersions.h"
32 import PrimRep -- most of it
36 import CStrings ( identToC )
37 import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
38 import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
40 import PprType ( pprParendType )
41 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
42 import TyCon ( TyCon{-instances-} )
43 import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp, typePrimRep,
44 splitAlgTyConApp, Type
46 import TyVar --( alphaTyVar, betaTyVar, gammaTyVar )
47 import Unique ( Unique{-instance Eq-} )
48 import Util ( panic#, assoc, panic{-ToDo:rm-} )
50 import GlaExts ( Int(..), Int#, (==#) )
53 %************************************************************************
55 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
57 %************************************************************************
59 These are in \tr{state-interface.verb} order.
63 -- dig the FORTRAN/C influence on the names...
67 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
68 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
69 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
70 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
71 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
72 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
78 -- IntAbsOp unused?? ADR
79 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
80 | IntRemOp | IntNegOp | IntAbsOp
81 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
84 | WordQuotOp | WordRemOp
85 | AndOp | OrOp | NotOp | XorOp
86 | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
87 | Int2WordOp | Word2IntOp -- casts
90 | Int2AddrOp | Addr2IntOp -- casts
92 -- Float#-related ops:
93 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
94 | Float2IntOp | Int2FloatOp
96 | FloatExpOp | FloatLogOp | FloatSqrtOp
97 | FloatSinOp | FloatCosOp | FloatTanOp
98 | FloatAsinOp | FloatAcosOp | FloatAtanOp
99 | FloatSinhOp | FloatCoshOp | FloatTanhOp
100 -- not all machines have these available conveniently:
101 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
102 | FloatPowerOp -- ** op
104 -- Double#-related ops:
105 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
106 | Double2IntOp | Int2DoubleOp
107 | Double2FloatOp | Float2DoubleOp
109 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
110 | DoubleSinOp | DoubleCosOp | DoubleTanOp
111 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
112 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
113 -- not all machines have these available conveniently:
114 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
115 | DoublePowerOp -- ** op
117 -- Integer (and related...) ops:
118 -- slightly weird -- to match GMP package.
119 | IntegerAddOp | IntegerSubOp | IntegerMulOp
120 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
124 | Integer2IntOp | Integer2WordOp
125 | Int2IntegerOp | Word2IntegerOp
126 | Addr2IntegerOp -- "Addr" is *always* a literal string
129 | FloatEncodeOp | FloatDecodeOp
130 | DoubleEncodeOp | DoubleDecodeOp
132 -- primitive ops for primitive arrays
135 | NewByteArrayOp PrimRep
138 | SameMutableByteArrayOp
140 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
142 | ReadByteArrayOp PrimRep
143 | WriteByteArrayOp PrimRep
144 | IndexByteArrayOp PrimRep
145 | IndexOffAddrOp PrimRep
146 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
147 -- This is just a cheesy encoding of a bunch of ops.
148 -- Note that ForeignObjRep is not included -- the only way of
149 -- creating a ForeignObj is with a ccall or casm.
150 | IndexOffForeignObjOp PrimRep
152 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
153 | SizeofByteArrayOp | SizeofMutableByteArrayOp
155 | NewSynchVarOp -- for MVars and IVars
157 | TakeMVarOp | PutMVarOp
158 | ReadIVarOp | WriteIVarOp
160 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
161 | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
162 | MakeStablePtrOp | DeRefStablePtrOp
165 A special ``trap-door'' to use in making calls direct to C functions:
167 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
168 Bool -- True <=> really a "casm"
169 Bool -- True <=> might invoke Haskell GC
170 [Type] -- Unboxed argument; the state-token
171 -- argument will have been put *first*
172 Type -- Return type; one of the "StateAnd<blah>#" types
174 -- (... to be continued ... )
177 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
178 (See @primOpInfo@ for details.)
180 Note: that first arg and part of the result should be the system state
181 token (which we carry around to fool over-zealous optimisers) but
182 which isn't actually passed.
184 For example, we represent
186 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
192 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
193 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
197 (AlgAlts [ ( FloatPrimAndIoWorld,
199 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
205 Nota Bene: there are some people who find the empty list of types in
206 the @Prim@ somewhat puzzling and would represent the above by
210 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
211 -- :: /\ alpha1, alpha2 alpha3, alpha4.
212 -- alpha1 -> alpha2 -> alpha3 -> alpha4
213 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
216 (AlgAlts [ ( FloatPrimAndIoWorld,
218 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
224 But, this is a completely different way of using @CCallOp@. The most
225 major changes required if we switch to this are in @primOpInfo@, and
226 the desugarer. The major difficulty is in moving the HeapRequirement
227 stuff somewhere appropriate. (The advantage is that we could simplify
228 @CCallOp@ and record just the number of arguments with corresponding
229 simplifications in reading pragma unfoldings, the simplifier,
230 instantiation (etc) of core expressions, ... . Maybe we should think
231 about using it this way?? ADR)
234 -- (... continued from above ... )
236 -- one to support "errorIO" (and, thereby, "error")
239 -- Operation to test two closure addresses for equality (yes really!)
240 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
241 | ReallyUnsafePtrEqualityOp
243 -- three for parallel stuff
248 -- three for concurrency
253 | ParGlobalOp -- named global par
254 | ParLocalOp -- named local par
255 | ParAtOp -- specifies destination of local par
256 | ParAtAbsOp -- specifies destination of local par (abs processor)
257 | ParAtRelOp -- specifies destination of local par (rel processor)
258 | ParAtForNowOp -- specifies initial destination of global par
259 | CopyableOp -- marks copyable code
260 | NoFollowOp -- marks non-followup expression
263 Deriving Ix is what we really want! ToDo
264 (Chk around before deleting...)
266 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
267 tagOf_PrimOp CharGeOp = ILIT( 2)
268 tagOf_PrimOp CharEqOp = ILIT( 3)
269 tagOf_PrimOp CharNeOp = ILIT( 4)
270 tagOf_PrimOp CharLtOp = ILIT( 5)
271 tagOf_PrimOp CharLeOp = ILIT( 6)
272 tagOf_PrimOp IntGtOp = ILIT( 7)
273 tagOf_PrimOp IntGeOp = ILIT( 8)
274 tagOf_PrimOp IntEqOp = ILIT( 9)
275 tagOf_PrimOp IntNeOp = ILIT( 10)
276 tagOf_PrimOp IntLtOp = ILIT( 11)
277 tagOf_PrimOp IntLeOp = ILIT( 12)
278 tagOf_PrimOp WordGtOp = ILIT( 13)
279 tagOf_PrimOp WordGeOp = ILIT( 14)
280 tagOf_PrimOp WordEqOp = ILIT( 15)
281 tagOf_PrimOp WordNeOp = ILIT( 16)
282 tagOf_PrimOp WordLtOp = ILIT( 17)
283 tagOf_PrimOp WordLeOp = ILIT( 18)
284 tagOf_PrimOp AddrGtOp = ILIT( 19)
285 tagOf_PrimOp AddrGeOp = ILIT( 20)
286 tagOf_PrimOp AddrEqOp = ILIT( 21)
287 tagOf_PrimOp AddrNeOp = ILIT( 22)
288 tagOf_PrimOp AddrLtOp = ILIT( 23)
289 tagOf_PrimOp AddrLeOp = ILIT( 24)
290 tagOf_PrimOp FloatGtOp = ILIT( 25)
291 tagOf_PrimOp FloatGeOp = ILIT( 26)
292 tagOf_PrimOp FloatEqOp = ILIT( 27)
293 tagOf_PrimOp FloatNeOp = ILIT( 28)
294 tagOf_PrimOp FloatLtOp = ILIT( 29)
295 tagOf_PrimOp FloatLeOp = ILIT( 30)
296 tagOf_PrimOp DoubleGtOp = ILIT( 31)
297 tagOf_PrimOp DoubleGeOp = ILIT( 32)
298 tagOf_PrimOp DoubleEqOp = ILIT( 33)
299 tagOf_PrimOp DoubleNeOp = ILIT( 34)
300 tagOf_PrimOp DoubleLtOp = ILIT( 35)
301 tagOf_PrimOp DoubleLeOp = ILIT( 36)
302 tagOf_PrimOp OrdOp = ILIT( 37)
303 tagOf_PrimOp ChrOp = ILIT( 38)
304 tagOf_PrimOp IntAddOp = ILIT( 39)
305 tagOf_PrimOp IntSubOp = ILIT( 40)
306 tagOf_PrimOp IntMulOp = ILIT( 41)
307 tagOf_PrimOp IntQuotOp = ILIT( 42)
308 tagOf_PrimOp IntRemOp = ILIT( 44)
309 tagOf_PrimOp IntNegOp = ILIT( 45)
310 tagOf_PrimOp IntAbsOp = ILIT( 47)
311 tagOf_PrimOp WordQuotOp = ILIT( 48)
312 tagOf_PrimOp WordRemOp = ILIT( 49)
313 tagOf_PrimOp AndOp = ILIT( 50)
314 tagOf_PrimOp OrOp = ILIT( 51)
315 tagOf_PrimOp NotOp = ILIT( 52)
316 tagOf_PrimOp XorOp = ILIT( 53)
317 tagOf_PrimOp SllOp = ILIT( 54)
318 tagOf_PrimOp SraOp = ILIT( 55)
319 tagOf_PrimOp SrlOp = ILIT( 56)
320 tagOf_PrimOp ISllOp = ILIT( 57)
321 tagOf_PrimOp ISraOp = ILIT( 58)
322 tagOf_PrimOp ISrlOp = ILIT( 59)
323 tagOf_PrimOp Int2WordOp = ILIT( 60)
324 tagOf_PrimOp Word2IntOp = ILIT( 61)
325 tagOf_PrimOp Int2AddrOp = ILIT( 62)
326 tagOf_PrimOp Addr2IntOp = ILIT( 63)
327 tagOf_PrimOp FloatAddOp = ILIT( 64)
328 tagOf_PrimOp FloatSubOp = ILIT( 65)
329 tagOf_PrimOp FloatMulOp = ILIT( 66)
330 tagOf_PrimOp FloatDivOp = ILIT( 67)
331 tagOf_PrimOp FloatNegOp = ILIT( 68)
332 tagOf_PrimOp Float2IntOp = ILIT( 69)
333 tagOf_PrimOp Int2FloatOp = ILIT( 70)
334 tagOf_PrimOp FloatExpOp = ILIT( 71)
335 tagOf_PrimOp FloatLogOp = ILIT( 72)
336 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
337 tagOf_PrimOp FloatSinOp = ILIT( 74)
338 tagOf_PrimOp FloatCosOp = ILIT( 75)
339 tagOf_PrimOp FloatTanOp = ILIT( 76)
340 tagOf_PrimOp FloatAsinOp = ILIT( 77)
341 tagOf_PrimOp FloatAcosOp = ILIT( 78)
342 tagOf_PrimOp FloatAtanOp = ILIT( 79)
343 tagOf_PrimOp FloatSinhOp = ILIT( 80)
344 tagOf_PrimOp FloatCoshOp = ILIT( 81)
345 tagOf_PrimOp FloatTanhOp = ILIT( 82)
346 tagOf_PrimOp FloatPowerOp = ILIT( 83)
347 tagOf_PrimOp DoubleAddOp = ILIT( 84)
348 tagOf_PrimOp DoubleSubOp = ILIT( 85)
349 tagOf_PrimOp DoubleMulOp = ILIT( 86)
350 tagOf_PrimOp DoubleDivOp = ILIT( 87)
351 tagOf_PrimOp DoubleNegOp = ILIT( 88)
352 tagOf_PrimOp Double2IntOp = ILIT( 89)
353 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
354 tagOf_PrimOp Double2FloatOp = ILIT( 91)
355 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
356 tagOf_PrimOp DoubleExpOp = ILIT( 93)
357 tagOf_PrimOp DoubleLogOp = ILIT( 94)
358 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
359 tagOf_PrimOp DoubleSinOp = ILIT( 96)
360 tagOf_PrimOp DoubleCosOp = ILIT( 97)
361 tagOf_PrimOp DoubleTanOp = ILIT( 98)
362 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
363 tagOf_PrimOp DoubleAcosOp = ILIT(100)
364 tagOf_PrimOp DoubleAtanOp = ILIT(101)
365 tagOf_PrimOp DoubleSinhOp = ILIT(102)
366 tagOf_PrimOp DoubleCoshOp = ILIT(103)
367 tagOf_PrimOp DoubleTanhOp = ILIT(104)
368 tagOf_PrimOp DoublePowerOp = ILIT(105)
369 tagOf_PrimOp IntegerAddOp = ILIT(106)
370 tagOf_PrimOp IntegerSubOp = ILIT(107)
371 tagOf_PrimOp IntegerMulOp = ILIT(108)
372 tagOf_PrimOp IntegerQuotRemOp = ILIT(109)
373 tagOf_PrimOp IntegerDivModOp = ILIT(110)
374 tagOf_PrimOp IntegerNegOp = ILIT(111)
375 tagOf_PrimOp IntegerCmpOp = ILIT(112)
376 tagOf_PrimOp Integer2IntOp = ILIT(113)
377 tagOf_PrimOp Integer2WordOp = ILIT(114)
378 tagOf_PrimOp Int2IntegerOp = ILIT(115)
379 tagOf_PrimOp Word2IntegerOp = ILIT(116)
380 tagOf_PrimOp Addr2IntegerOp = ILIT(117)
381 tagOf_PrimOp FloatEncodeOp = ILIT(118)
382 tagOf_PrimOp FloatDecodeOp = ILIT(119)
383 tagOf_PrimOp DoubleEncodeOp = ILIT(120)
384 tagOf_PrimOp DoubleDecodeOp = ILIT(121)
385 tagOf_PrimOp NewArrayOp = ILIT(122)
386 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(123)
387 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(124)
388 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(125)
389 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(126)
390 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(127)
391 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(128)
392 tagOf_PrimOp SameMutableArrayOp = ILIT(129)
393 tagOf_PrimOp SameMutableByteArrayOp = ILIT(130)
394 tagOf_PrimOp ReadArrayOp = ILIT(131)
395 tagOf_PrimOp WriteArrayOp = ILIT(132)
396 tagOf_PrimOp IndexArrayOp = ILIT(133)
397 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(134)
398 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(135)
399 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(136)
400 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(137)
401 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(138)
402 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(139)
403 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(140)
404 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(141)
405 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(142)
406 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(143)
407 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(144)
408 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(145)
409 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(146)
410 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(147)
411 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(148)
412 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(149)
413 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(150)
414 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(151)
415 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(152)
416 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(153)
417 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(154)
418 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(155)
419 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(156)
420 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(157)
421 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(158)
422 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(159)
423 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(160)
424 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(161)
425 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(162)
426 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(163)
427 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(164)
428 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(165)
429 tagOf_PrimOp SizeofByteArrayOp = ILIT(166)
430 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(167)
431 tagOf_PrimOp NewSynchVarOp = ILIT(168)
432 tagOf_PrimOp TakeMVarOp = ILIT(169)
433 tagOf_PrimOp PutMVarOp = ILIT(170)
434 tagOf_PrimOp ReadIVarOp = ILIT(171)
435 tagOf_PrimOp WriteIVarOp = ILIT(172)
436 tagOf_PrimOp MakeForeignObjOp = ILIT(173)
437 tagOf_PrimOp WriteForeignObjOp = ILIT(174)
438 tagOf_PrimOp MakeStablePtrOp = ILIT(175)
439 tagOf_PrimOp DeRefStablePtrOp = ILIT(176)
440 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(177)
441 tagOf_PrimOp ErrorIOPrimOp = ILIT(178)
442 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(179)
443 tagOf_PrimOp SeqOp = ILIT(180)
444 tagOf_PrimOp ParOp = ILIT(181)
445 tagOf_PrimOp ForkOp = ILIT(182)
446 tagOf_PrimOp DelayOp = ILIT(183)
447 tagOf_PrimOp WaitReadOp = ILIT(184)
448 tagOf_PrimOp WaitWriteOp = ILIT(185)
449 tagOf_PrimOp ParGlobalOp = ILIT(186)
450 tagOf_PrimOp ParLocalOp = ILIT(187)
451 tagOf_PrimOp ParAtOp = ILIT(188)
452 tagOf_PrimOp ParAtAbsOp = ILIT(189)
453 tagOf_PrimOp ParAtRelOp = ILIT(190)
454 tagOf_PrimOp ParAtForNowOp = ILIT(191)
455 tagOf_PrimOp CopyableOp = ILIT(192)
456 tagOf_PrimOp NoFollowOp = ILIT(193)
457 tagOf_PrimOp SameMVarOp = ILIT(194)
459 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
461 instance Eq PrimOp where
462 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
465 An @Enum@-derived list would be better; meanwhile... (ToDo)
587 NewByteArrayOp CharRep,
588 NewByteArrayOp IntRep,
589 NewByteArrayOp WordRep,
590 NewByteArrayOp AddrRep,
591 NewByteArrayOp FloatRep,
592 NewByteArrayOp DoubleRep,
594 SameMutableByteArrayOp,
598 ReadByteArrayOp CharRep,
599 ReadByteArrayOp IntRep,
600 ReadByteArrayOp WordRep,
601 ReadByteArrayOp AddrRep,
602 ReadByteArrayOp FloatRep,
603 ReadByteArrayOp DoubleRep,
604 WriteByteArrayOp CharRep,
605 WriteByteArrayOp IntRep,
606 WriteByteArrayOp WordRep,
607 WriteByteArrayOp AddrRep,
608 WriteByteArrayOp FloatRep,
609 WriteByteArrayOp DoubleRep,
610 IndexByteArrayOp CharRep,
611 IndexByteArrayOp IntRep,
612 IndexByteArrayOp WordRep,
613 IndexByteArrayOp AddrRep,
614 IndexByteArrayOp FloatRep,
615 IndexByteArrayOp DoubleRep,
616 IndexOffAddrOp CharRep,
617 IndexOffAddrOp IntRep,
618 IndexOffAddrOp WordRep,
619 IndexOffAddrOp AddrRep,
620 IndexOffAddrOp FloatRep,
621 IndexOffAddrOp DoubleRep,
622 IndexOffForeignObjOp CharRep,
623 IndexOffForeignObjOp IntRep,
624 IndexOffForeignObjOp WordRep,
625 IndexOffForeignObjOp AddrRep,
626 IndexOffForeignObjOp FloatRep,
627 IndexOffForeignObjOp DoubleRep,
629 UnsafeFreezeByteArrayOp,
631 SizeofMutableByteArrayOp,
643 ReallyUnsafePtrEqualityOp,
662 %************************************************************************
664 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
666 %************************************************************************
668 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
669 refer to the primitive operation. The conventional \tr{#}-for-
670 unboxed ops is added on later.
672 The reason for the funny characters in the names is so we do not
673 interfere with the programmer's Haskell name spaces.
675 We use @PrimKinds@ for the ``type'' information, because they're
676 (slightly) more convenient to use than @TyCons@.
679 = Dyadic FAST_STRING -- string :: T -> T -> T
681 | Monadic FAST_STRING -- string :: T -> T
683 | Compare FAST_STRING -- string :: T -> T -> Bool
685 | Coercing FAST_STRING -- string :: T1 -> T2
689 | PrimResult FAST_STRING
690 [TyVar] [Type] TyCon PrimRep [Type]
691 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
692 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
693 -- D# is a primitive type constructor.
694 -- (the kind is the same info as D#, in another convenient form)
696 | AlgResult FAST_STRING
697 [TyVar] [Type] TyCon [Type]
698 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
699 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
701 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
706 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
708 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
709 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
710 an_Integer_and_Int_tys
711 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
714 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
716 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
718 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
720 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
723 @primOpInfo@ gives all essential information (from which everything
724 else, notably a type, can be constructed) for each @PrimOp@.
727 primOpInfo :: PrimOp -> PrimOpInfo
730 There's plenty of this stuff!
732 %************************************************************************
734 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
736 %************************************************************************
739 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
740 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
741 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
742 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
743 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
744 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
746 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
747 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
748 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
749 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
750 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
751 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
753 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
754 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
755 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
756 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
757 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
758 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
760 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
761 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
762 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
763 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
764 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
765 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
767 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
768 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
769 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
770 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
771 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
772 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
774 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
775 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
776 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
777 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
778 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
779 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
782 %************************************************************************
784 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
786 %************************************************************************
789 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
790 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
793 %************************************************************************
795 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
797 %************************************************************************
800 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
801 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
802 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
803 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
804 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
806 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
807 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
810 %************************************************************************
812 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
814 %************************************************************************
816 A @Word#@ is an unsigned @Int#@.
819 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
820 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
822 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
823 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
824 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
825 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
828 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
830 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
832 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
835 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
837 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
839 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
841 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
842 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
845 %************************************************************************
847 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
849 %************************************************************************
852 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
853 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
856 %************************************************************************
858 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
860 %************************************************************************
862 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
866 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
867 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
868 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
869 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
870 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
872 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
873 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
875 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
876 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
877 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
878 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
879 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
880 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
881 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
882 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
883 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
884 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
885 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
886 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
887 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
890 %************************************************************************
892 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
894 %************************************************************************
896 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
900 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
901 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
902 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
903 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
904 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
906 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
907 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
909 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
910 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
912 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
913 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
914 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
915 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
916 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
917 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
918 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
919 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
920 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
921 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
922 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
923 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
924 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
927 %************************************************************************
929 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
931 %************************************************************************
934 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
936 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
937 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
938 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
940 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
942 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
943 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
945 primOpInfo Integer2IntOp
946 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
948 primOpInfo Integer2WordOp
949 = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
951 primOpInfo Int2IntegerOp
952 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
954 primOpInfo Word2IntegerOp
955 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
957 primOpInfo Addr2IntegerOp
958 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
961 Encoding and decoding of floating-point numbers is sorta
965 primOpInfo FloatEncodeOp
966 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
967 floatPrimTyCon FloatRep []
969 primOpInfo DoubleEncodeOp
970 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
971 doublePrimTyCon DoubleRep []
973 primOpInfo FloatDecodeOp
974 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
976 primOpInfo DoubleDecodeOp
977 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
980 %************************************************************************
982 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
984 %************************************************************************
987 primOpInfo NewArrayOp
989 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
991 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
992 stateAndMutableArrayPrimTyCon [s, elt]
994 primOpInfo (NewByteArrayOp kind)
996 s = alphaTy; s_tv = alphaTyVar
998 (str, _, prim_tycon) = getPrimRepInfo kind
1000 op_str = _PK_ ("new" ++ str ++ "Array#")
1002 AlgResult op_str [s_tv]
1003 [intPrimTy, mkStatePrimTy s]
1004 stateAndMutableByteArrayPrimTyCon [s]
1006 ---------------------------------------------------------------------------
1008 primOpInfo SameMutableArrayOp
1010 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1011 mut_arr_ty = mkMutableArrayPrimTy s elt
1013 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1016 primOpInfo SameMutableByteArrayOp
1018 s = alphaTy; s_tv = alphaTyVar;
1019 mut_arr_ty = mkMutableByteArrayPrimTy s
1021 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1024 ---------------------------------------------------------------------------
1025 -- Primitive arrays of Haskell pointers:
1027 primOpInfo ReadArrayOp
1029 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1031 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1032 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1033 stateAndPtrPrimTyCon [s, elt]
1036 primOpInfo WriteArrayOp
1038 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1040 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1041 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1042 statePrimTyCon VoidRep [s]
1044 primOpInfo IndexArrayOp
1045 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1046 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1049 ---------------------------------------------------------------------------
1050 -- Primitive arrays full of unboxed bytes:
1052 primOpInfo (ReadByteArrayOp kind)
1054 s = alphaTy; s_tv = alphaTyVar
1056 (str, _, prim_tycon) = getPrimRepInfo kind
1058 op_str = _PK_ ("read" ++ str ++ "Array#")
1059 relevant_tycon = assoc "primOpInfo" tbl kind
1061 AlgResult op_str [s_tv]
1062 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1065 tbl = [ (CharRep, stateAndCharPrimTyCon),
1066 (IntRep, stateAndIntPrimTyCon),
1067 (WordRep, stateAndWordPrimTyCon),
1068 (AddrRep, stateAndAddrPrimTyCon),
1069 (FloatRep, stateAndFloatPrimTyCon),
1070 (DoubleRep, stateAndDoublePrimTyCon) ]
1072 -- How come there's no Word byte arrays? ADR
1074 primOpInfo (WriteByteArrayOp kind)
1076 s = alphaTy; s_tv = alphaTyVar
1078 (str, prim_ty, _) = getPrimRepInfo kind
1079 op_str = _PK_ ("write" ++ str ++ "Array#")
1081 -- NB: *Prim*Result --
1082 PrimResult op_str [s_tv]
1083 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1084 statePrimTyCon VoidRep [s]
1086 primOpInfo (IndexByteArrayOp kind)
1088 (str, _, prim_tycon) = getPrimRepInfo kind
1089 op_str = _PK_ ("index" ++ str ++ "Array#")
1091 -- NB: *Prim*Result --
1092 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1094 primOpInfo (IndexOffAddrOp kind)
1096 (str, _, prim_tycon) = getPrimRepInfo kind
1097 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1099 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1101 primOpInfo (IndexOffForeignObjOp kind)
1103 (str, _, prim_tycon) = getPrimRepInfo kind
1104 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1106 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1108 ---------------------------------------------------------------------------
1109 primOpInfo UnsafeFreezeArrayOp
1111 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1113 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1114 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1115 stateAndArrayPrimTyCon [s, elt]
1117 primOpInfo UnsafeFreezeByteArrayOp
1118 = let { s = alphaTy; s_tv = alphaTyVar } in
1119 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1120 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1121 stateAndByteArrayPrimTyCon [s]
1122 ---------------------------------------------------------------------------
1123 primOpInfo SizeofByteArrayOp
1125 SLIT("sizeofByteArray#") []
1127 intPrimTyCon IntRep []
1129 primOpInfo SizeofMutableByteArrayOp
1130 = let { s = alphaTy; s_tv = alphaTyVar } in
1132 SLIT("sizeofMutableByteArray#") [s_tv]
1133 [mkMutableByteArrayPrimTy s]
1134 intPrimTyCon IntRep []
1138 %************************************************************************
1140 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1142 %************************************************************************
1145 primOpInfo NewSynchVarOp
1147 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1149 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1150 stateAndSynchVarPrimTyCon [s, elt]
1152 primOpInfo SameMVarOp
1154 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1155 mvar_ty = mkSynchVarPrimTy s elt
1157 AlgResult SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty]
1160 primOpInfo TakeMVarOp
1162 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1164 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1165 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1166 stateAndPtrPrimTyCon [s, elt]
1168 primOpInfo PutMVarOp
1170 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1172 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1173 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1176 primOpInfo ReadIVarOp
1178 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1180 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1181 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1182 stateAndPtrPrimTyCon [s, elt]
1184 primOpInfo WriteIVarOp
1186 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1188 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1189 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1194 %************************************************************************
1196 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1198 %************************************************************************
1204 s = alphaTy; s_tv = alphaTyVar
1206 PrimResult SLIT("delay#") [s_tv]
1207 [intPrimTy, mkStatePrimTy s]
1208 statePrimTyCon VoidRep [s]
1210 primOpInfo WaitReadOp
1212 s = alphaTy; s_tv = alphaTyVar
1214 PrimResult SLIT("waitRead#") [s_tv]
1215 [intPrimTy, mkStatePrimTy s]
1216 statePrimTyCon VoidRep [s]
1218 primOpInfo WaitWriteOp
1220 s = alphaTy; s_tv = alphaTyVar
1222 PrimResult SLIT("waitWrite#") [s_tv]
1223 [intPrimTy, mkStatePrimTy s]
1224 statePrimTyCon VoidRep [s]
1227 %************************************************************************
1229 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1231 %************************************************************************
1233 Not everything should/can be in the Haskell heap. As an example, in an
1234 image processing application written in Haskell, you really would like
1235 to avoid heaving huge images between different space or generations of
1236 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1237 which refer to some externally allocated structure/value. Using @ForeignObj@,
1238 just a reference to an image is present in the heap, the image could then
1239 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1240 a completely separate address space alltogether.
1242 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1243 associated with the object is invoked (currently, each ForeignObj has a
1244 direct reference to its finaliser). -- SOF
1246 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1249 makeForeignObj# :: Addr# -- foreign object
1250 -> Addr# -- ptr to its finaliser routine
1251 -> StateAndForeignObj# _RealWorld# ForeignObj#
1256 primOpInfo MakeForeignObjOp
1257 = AlgResult SLIT("makeForeignObj#") []
1258 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1259 stateAndForeignObjPrimTyCon [realWorldTy]
1263 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1264 the external object wrapped up inside a @ForeignObj@. This primitive is used
1265 when a mixed programming interface of implicit and explicit de-allocation is used,
1266 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1267 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1268 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1269 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1270 We deal with this situation, by allowing the programmer to destructively modify
1271 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1272 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1275 writeForeignObj# :: ForeignObj# -- foreign object
1276 -> Addr# -- new data value
1277 -> StateAndForeignObj# _RealWorld# ForeignObj#
1281 primOpInfo WriteForeignObjOp
1283 s = alphaTy; s_tv = alphaTyVar
1285 PrimResult SLIT("writeForeignObj#") [s_tv]
1286 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1287 statePrimTyCon VoidRep [s]
1290 %************************************************************************
1292 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1294 %************************************************************************
1296 A {\em stable pointer} is an index into a table of pointers into the
1297 heap. Since the garbage collector is told about stable pointers, it
1298 is safe to pass a stable pointer to external systems such as C
1301 Here's what the operations and types are supposed to be (from
1302 state-interface document).
1305 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1306 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1307 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1310 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1311 operation since it doesn't (directly) involve IO operations. The
1312 reason is that if some optimisation pass decided to duplicate calls to
1313 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1314 massive space leak can result. Putting it into the PrimIO monad
1315 prevents this. (Another reason for putting them in a monad is to
1316 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1319 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1320 besides, it's not likely to be used from Haskell) so it's not a
1323 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1326 primOpInfo MakeStablePtrOp
1327 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1328 [alphaTy, realWorldStatePrimTy]
1329 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1331 primOpInfo DeRefStablePtrOp
1332 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1333 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1334 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1337 %************************************************************************
1339 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1341 %************************************************************************
1343 [Alastair Reid is to blame for this!]
1345 These days, (Glasgow) Haskell seems to have a bit of everything from
1346 other languages: strict operations, mutable variables, sequencing,
1347 pointers, etc. About the only thing left is LISP's ability to test
1348 for pointer equality. So, let's add it in!
1351 reallyUnsafePtrEquality :: a -> a -> Int#
1354 which tests any two closures (of the same type) to see if they're the
1355 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1356 difficulties of trying to box up the result.)
1358 NB This is {\em really unsafe\/} because even something as trivial as
1359 a garbage collection might change the answer by removing indirections.
1360 Still, no-one's forcing you to use it. If you're worried about little
1361 things like loss of referential transparency, you might like to wrap
1362 it all up in a monad-like thing as John O'Donnell and John Hughes did
1363 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1366 I'm thinking of using it to speed up a critical equality test in some
1367 graphics stuff in a context where the possibility of saying that
1368 denotationally equal things aren't isn't a problem (as long as it
1369 doesn't happen too often.) ADR
1371 To Will: Jim said this was already in, but I can't see it so I'm
1372 adding it. Up to you whether you add it. (Note that this could have
1373 been readily implemented using a @veryDangerousCCall@ before they were
1377 primOpInfo ReallyUnsafePtrEqualityOp
1378 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1379 [alphaTy, alphaTy] intPrimTyCon IntRep []
1382 %************************************************************************
1384 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1386 %************************************************************************
1389 primOpInfo SeqOp -- seq# :: a -> Int#
1390 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1392 primOpInfo ParOp -- par# :: a -> Int#
1393 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1395 primOpInfo ForkOp -- fork# :: a -> Int#
1396 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1401 -- HWL: The first 4 Int# in all par... annotations denote:
1402 -- name, granularity info, size of result, degree of parallelism
1403 -- Same structure as _seq_ i.e. returns Int#
1405 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1406 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1408 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1409 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1411 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1412 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1414 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1415 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1417 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1418 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1420 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1421 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1423 primOpInfo CopyableOp -- copyable# :: a -> a
1424 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1426 primOpInfo NoFollowOp -- noFollow# :: a -> a
1427 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1430 %************************************************************************
1432 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1434 %************************************************************************
1437 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1438 primOpInfo ErrorIOPrimOp
1439 = PrimResult SLIT("errorIO#") [alphaTyVar]
1440 [mkFunTy realWorldStatePrimTy alphaTy]
1441 statePrimTyCon VoidRep [realWorldTy]
1444 %************************************************************************
1446 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1448 %************************************************************************
1451 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1452 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1454 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1457 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1461 %************************************************************************
1463 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1465 %************************************************************************
1467 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1468 with @Integers@ can trigger GC. Here we describe the heap requirements
1469 of the various @PrimOps@. For most, no heap is required. For a few,
1470 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1471 be combined with the rest of the heap usage in the basic block. For an
1472 unfortunate few, some unknown amount of heap is required (these are the
1473 ops which can trigger GC).
1476 data HeapRequirement
1478 | FixedHeapRequired HeapOffset
1479 | VariableHeapRequired
1481 primOpHeapReq :: PrimOp -> HeapRequirement
1483 primOpHeapReq NewArrayOp = VariableHeapRequired
1484 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1486 primOpHeapReq IntegerAddOp = VariableHeapRequired
1487 primOpHeapReq IntegerSubOp = VariableHeapRequired
1488 primOpHeapReq IntegerMulOp = VariableHeapRequired
1489 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1490 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1491 primOpHeapReq IntegerNegOp = VariableHeapRequired
1492 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1493 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1494 (intOff mIN_MP_INT_SIZE))
1495 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1496 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1497 (intOff mIN_MP_INT_SIZE))
1498 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1499 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1500 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1501 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1502 (intOff mIN_MP_INT_SIZE)))
1503 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1504 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1505 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1506 (intOff mIN_MP_INT_SIZE)))
1509 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1510 or if it returns a ForeignObj.
1512 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1513 why do we need to be so indeterminate about it? --SOF
1515 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1516 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1518 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1519 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1521 -- this occasionally has to expand the Stable Pointer table
1522 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1524 -- These four only need heap space with the native code generator
1525 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1527 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1528 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1529 primOpHeapReq Integer2WordOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1530 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1531 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1533 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1534 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1535 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1537 -- Sparking ops no longer allocate any heap; however, _fork_ may
1538 -- require a context switch to clear space in the required thread
1539 -- pool, and that requires liveness information.
1541 primOpHeapReq ParOp = NoHeapRequired
1542 primOpHeapReq ForkOp = VariableHeapRequired
1544 -- A SeqOp requires unknown space to evaluate its argument
1545 primOpHeapReq SeqOp = VariableHeapRequired
1547 -- GranSim sparks are stgMalloced i.e. no heap required
1548 primOpHeapReq ParGlobalOp = NoHeapRequired
1549 primOpHeapReq ParLocalOp = NoHeapRequired
1550 primOpHeapReq ParAtOp = NoHeapRequired
1551 primOpHeapReq ParAtAbsOp = NoHeapRequired
1552 primOpHeapReq ParAtRelOp = NoHeapRequired
1553 primOpHeapReq ParAtForNowOp = NoHeapRequired
1554 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1555 primOpHeapReq CopyableOp = NoHeapRequired
1556 primOpHeapReq NoFollowOp = NoHeapRequired
1558 primOpHeapReq other_op = NoHeapRequired
1561 The amount of stack required by primops.
1564 data StackRequirement
1566 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1567 | VariableStackRequired
1569 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1570 primOpStackRequired _ = VariableStackRequired
1571 -- ToDo: be more specific for certain primops (currently only used for seq)
1574 Primops which can trigger GC have to be called carefully.
1575 In particular, their arguments are guaranteed to be in registers,
1576 and a liveness mask tells which regs are live.
1579 primOpCanTriggerGC op
1587 case primOpHeapReq op of
1588 VariableHeapRequired -> True
1592 Sometimes we may choose to execute a PrimOp even though it isn't
1593 certain that its result will be required; ie execute them
1594 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1595 this is OK, because PrimOps are usually cheap, but it isn't OK for
1596 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1598 See also @primOpIsCheap@ (below).
1600 There should be no worries about side effects; that's all taken care
1601 of by data dependencies.
1604 primOpOkForSpeculation :: PrimOp -> Bool
1607 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1608 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1611 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1612 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1614 -- Float. ToDo: tan? tanh?
1615 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1616 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1617 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1618 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1620 -- Double. ToDo: tan? tanh?
1621 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1622 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1623 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1624 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1627 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1630 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1633 primOpOkForSpeculation ParOp = False -- Could be expensive!
1634 primOpOkForSpeculation ForkOp = False -- Likewise
1635 primOpOkForSpeculation SeqOp = False -- Likewise
1637 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1638 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1639 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1640 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1641 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1642 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1643 primOpOkForSpeculation CopyableOp = False -- only tags closure
1644 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1646 -- The default is "yes it's ok for speculation"
1647 primOpOkForSpeculation other_op = True
1650 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1651 WARNING), we just borrow some other predicates for a
1652 what-should-be-good-enough test.
1655 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1658 And some primops have side-effects and so, for example, must not be
1662 fragilePrimOp :: PrimOp -> Bool
1664 fragilePrimOp ParOp = True
1665 fragilePrimOp ForkOp = True
1666 fragilePrimOp SeqOp = True
1667 fragilePrimOp MakeForeignObjOp = True -- SOF
1668 fragilePrimOp WriteForeignObjOp = True -- SOF
1669 fragilePrimOp MakeStablePtrOp = True
1670 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1672 fragilePrimOp ParGlobalOp = True
1673 fragilePrimOp ParLocalOp = True
1674 fragilePrimOp ParAtOp = True
1675 fragilePrimOp ParAtAbsOp = True
1676 fragilePrimOp ParAtRelOp = True
1677 fragilePrimOp ParAtForNowOp = True
1678 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1679 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1681 fragilePrimOp other = False
1684 Primitive operations that perform calls need wrappers to save any live variables
1685 that are stored in caller-saves registers
1688 primOpNeedsWrapper :: PrimOp -> Bool
1690 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1692 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1693 primOpNeedsWrapper (NewByteArrayOp _) = True
1695 primOpNeedsWrapper IntegerAddOp = True
1696 primOpNeedsWrapper IntegerSubOp = True
1697 primOpNeedsWrapper IntegerMulOp = True
1698 primOpNeedsWrapper IntegerQuotRemOp = True
1699 primOpNeedsWrapper IntegerDivModOp = True
1700 primOpNeedsWrapper IntegerNegOp = True
1701 primOpNeedsWrapper IntegerCmpOp = True
1702 primOpNeedsWrapper Integer2IntOp = True
1703 primOpNeedsWrapper Integer2WordOp = True
1704 primOpNeedsWrapper Int2IntegerOp = True
1705 primOpNeedsWrapper Word2IntegerOp = True
1706 primOpNeedsWrapper Addr2IntegerOp = True
1708 primOpNeedsWrapper FloatExpOp = True
1709 primOpNeedsWrapper FloatLogOp = True
1710 primOpNeedsWrapper FloatSqrtOp = True
1711 primOpNeedsWrapper FloatSinOp = True
1712 primOpNeedsWrapper FloatCosOp = True
1713 primOpNeedsWrapper FloatTanOp = True
1714 primOpNeedsWrapper FloatAsinOp = True
1715 primOpNeedsWrapper FloatAcosOp = True
1716 primOpNeedsWrapper FloatAtanOp = True
1717 primOpNeedsWrapper FloatSinhOp = True
1718 primOpNeedsWrapper FloatCoshOp = True
1719 primOpNeedsWrapper FloatTanhOp = True
1720 primOpNeedsWrapper FloatPowerOp = True
1721 primOpNeedsWrapper FloatEncodeOp = True
1722 primOpNeedsWrapper FloatDecodeOp = True
1724 primOpNeedsWrapper DoubleExpOp = True
1725 primOpNeedsWrapper DoubleLogOp = True
1726 primOpNeedsWrapper DoubleSqrtOp = True
1727 primOpNeedsWrapper DoubleSinOp = True
1728 primOpNeedsWrapper DoubleCosOp = True
1729 primOpNeedsWrapper DoubleTanOp = True
1730 primOpNeedsWrapper DoubleAsinOp = True
1731 primOpNeedsWrapper DoubleAcosOp = True
1732 primOpNeedsWrapper DoubleAtanOp = True
1733 primOpNeedsWrapper DoubleSinhOp = True
1734 primOpNeedsWrapper DoubleCoshOp = True
1735 primOpNeedsWrapper DoubleTanhOp = True
1736 primOpNeedsWrapper DoublePowerOp = True
1737 primOpNeedsWrapper DoubleEncodeOp = True
1738 primOpNeedsWrapper DoubleDecodeOp = True
1740 primOpNeedsWrapper MakeForeignObjOp = True
1741 primOpNeedsWrapper WriteForeignObjOp = True
1742 primOpNeedsWrapper MakeStablePtrOp = True
1743 primOpNeedsWrapper DeRefStablePtrOp = True
1745 primOpNeedsWrapper TakeMVarOp = True
1746 primOpNeedsWrapper PutMVarOp = True
1747 primOpNeedsWrapper ReadIVarOp = True
1749 primOpNeedsWrapper DelayOp = True
1750 primOpNeedsWrapper WaitReadOp = True
1751 primOpNeedsWrapper WaitWriteOp = True
1753 primOpNeedsWrapper other_op = False
1758 = case (primOpInfo op) of
1760 Monadic str _ -> str
1761 Compare str _ -> str
1762 Coercing str _ _ -> str
1763 PrimResult str _ _ _ _ _ -> str
1764 AlgResult str _ _ _ _ -> str
1767 @primOpType@ duplicates some work of @primOpId@, but since we
1768 grab types pretty often...
1770 primOpType :: PrimOp -> Type
1773 = case (primOpInfo op) of
1774 Dyadic str ty -> dyadic_fun_ty ty
1775 Monadic str ty -> monadic_fun_ty ty
1776 Compare str ty -> compare_fun_ty ty
1777 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1779 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1780 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1782 AlgResult str tyvars arg_tys tycon res_tys ->
1783 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1787 data PrimOpResultInfo
1788 = ReturnsPrim PrimRep
1791 -- ToDo: Deal with specialised PrimOps
1792 -- Will need to return specialised tycon and data constructors
1794 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1796 getPrimOpResultInfo op
1797 = case (primOpInfo op) of
1798 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1799 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1800 Compare _ ty -> ReturnsAlg boolTyCon
1801 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1802 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1803 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1805 isCompareOp :: PrimOp -> Bool
1808 = case primOpInfo op of
1813 The commutable ops are those for which we will try to move constants
1814 to the right hand side for strength reduction.
1817 commutableOp :: PrimOp -> Bool
1819 commutableOp CharEqOp = True
1820 commutableOp CharNeOp = True
1821 commutableOp IntAddOp = True
1822 commutableOp IntMulOp = True
1823 commutableOp AndOp = True
1824 commutableOp OrOp = True
1825 commutableOp XorOp = True
1826 commutableOp IntEqOp = True
1827 commutableOp IntNeOp = True
1828 commutableOp IntegerAddOp = True
1829 commutableOp IntegerMulOp = True
1830 commutableOp FloatAddOp = True
1831 commutableOp FloatMulOp = True
1832 commutableOp FloatEqOp = True
1833 commutableOp FloatNeOp = True
1834 commutableOp DoubleAddOp = True
1835 commutableOp DoubleMulOp = True
1836 commutableOp DoubleEqOp = True
1837 commutableOp DoubleNeOp = True
1838 commutableOp _ = False
1843 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1844 monadic_fun_ty ty = mkFunTy ty ty
1845 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1850 pprPrimOp :: PrimOp -> SDoc
1851 showPrimOp :: PrimOp -> String
1853 showPrimOp op = showSDoc (pprPrimOp op)
1855 pprPrimOp (CCallOp fun is_casm may_gc arg_tys res_ty)
1859 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1861 if may_gc then "_ccall_GC_ " else "_ccall_ "
1864 = if is_casm then text "''" else empty
1867 = hsep (map pprParendType (res_ty:arg_tys))
1869 hcat [text before, ptext fun, after, space, brackets pp_tys]
1872 = getPprStyle $ \ sty ->
1873 if codeStyle sty then -- For C just print the primop itself
1875 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1876 ptext SLIT("PrelGHC.") <> ptext str
1877 else -- Unqualified is good enough
1880 str = primOp_str other_op
1883 instance Outputable PrimOp where
1884 ppr op = pprPrimOp op