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
156 | TakeMVarOp | PutMVarOp
157 | ReadIVarOp | WriteIVarOp
159 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
160 | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
161 | MakeStablePtrOp | DeRefStablePtrOp
164 A special ``trap-door'' to use in making calls direct to C functions:
166 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
167 Bool -- True <=> really a "casm"
168 Bool -- True <=> might invoke Haskell GC
169 [Type] -- Unboxed argument; the state-token
170 -- argument will have been put *first*
171 Type -- Return type; one of the "StateAnd<blah>#" types
173 -- (... to be continued ... )
176 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
177 (See @primOpInfo@ for details.)
179 Note: that first arg and part of the result should be the system state
180 token (which we carry around to fool over-zealous optimisers) but
181 which isn't actually passed.
183 For example, we represent
185 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
191 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
192 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
196 (AlgAlts [ ( FloatPrimAndIoWorld,
198 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
204 Nota Bene: there are some people who find the empty list of types in
205 the @Prim@ somewhat puzzling and would represent the above by
209 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
210 -- :: /\ alpha1, alpha2 alpha3, alpha4.
211 -- alpha1 -> alpha2 -> alpha3 -> alpha4
212 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
215 (AlgAlts [ ( FloatPrimAndIoWorld,
217 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
223 But, this is a completely different way of using @CCallOp@. The most
224 major changes required if we switch to this are in @primOpInfo@, and
225 the desugarer. The major difficulty is in moving the HeapRequirement
226 stuff somewhere appropriate. (The advantage is that we could simplify
227 @CCallOp@ and record just the number of arguments with corresponding
228 simplifications in reading pragma unfoldings, the simplifier,
229 instantiation (etc) of core expressions, ... . Maybe we should think
230 about using it this way?? ADR)
233 -- (... continued from above ... )
235 -- one to support "errorIO" (and, thereby, "error")
238 -- Operation to test two closure addresses for equality (yes really!)
239 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
240 | ReallyUnsafePtrEqualityOp
242 -- three for parallel stuff
247 -- three for concurrency
252 | ParGlobalOp -- named global par
253 | ParLocalOp -- named local par
254 | ParAtOp -- specifies destination of local par
255 | ParAtAbsOp -- specifies destination of local par (abs processor)
256 | ParAtRelOp -- specifies destination of local par (rel processor)
257 | ParAtForNowOp -- specifies initial destination of global par
258 | CopyableOp -- marks copyable code
259 | NoFollowOp -- marks non-followup expression
262 Deriving Ix is what we really want! ToDo
263 (Chk around before deleting...)
265 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
266 tagOf_PrimOp CharGeOp = ILIT( 2)
267 tagOf_PrimOp CharEqOp = ILIT( 3)
268 tagOf_PrimOp CharNeOp = ILIT( 4)
269 tagOf_PrimOp CharLtOp = ILIT( 5)
270 tagOf_PrimOp CharLeOp = ILIT( 6)
271 tagOf_PrimOp IntGtOp = ILIT( 7)
272 tagOf_PrimOp IntGeOp = ILIT( 8)
273 tagOf_PrimOp IntEqOp = ILIT( 9)
274 tagOf_PrimOp IntNeOp = ILIT( 10)
275 tagOf_PrimOp IntLtOp = ILIT( 11)
276 tagOf_PrimOp IntLeOp = ILIT( 12)
277 tagOf_PrimOp WordGtOp = ILIT( 13)
278 tagOf_PrimOp WordGeOp = ILIT( 14)
279 tagOf_PrimOp WordEqOp = ILIT( 15)
280 tagOf_PrimOp WordNeOp = ILIT( 16)
281 tagOf_PrimOp WordLtOp = ILIT( 17)
282 tagOf_PrimOp WordLeOp = ILIT( 18)
283 tagOf_PrimOp AddrGtOp = ILIT( 19)
284 tagOf_PrimOp AddrGeOp = ILIT( 20)
285 tagOf_PrimOp AddrEqOp = ILIT( 21)
286 tagOf_PrimOp AddrNeOp = ILIT( 22)
287 tagOf_PrimOp AddrLtOp = ILIT( 23)
288 tagOf_PrimOp AddrLeOp = ILIT( 24)
289 tagOf_PrimOp FloatGtOp = ILIT( 25)
290 tagOf_PrimOp FloatGeOp = ILIT( 26)
291 tagOf_PrimOp FloatEqOp = ILIT( 27)
292 tagOf_PrimOp FloatNeOp = ILIT( 28)
293 tagOf_PrimOp FloatLtOp = ILIT( 29)
294 tagOf_PrimOp FloatLeOp = ILIT( 30)
295 tagOf_PrimOp DoubleGtOp = ILIT( 31)
296 tagOf_PrimOp DoubleGeOp = ILIT( 32)
297 tagOf_PrimOp DoubleEqOp = ILIT( 33)
298 tagOf_PrimOp DoubleNeOp = ILIT( 34)
299 tagOf_PrimOp DoubleLtOp = ILIT( 35)
300 tagOf_PrimOp DoubleLeOp = ILIT( 36)
301 tagOf_PrimOp OrdOp = ILIT( 37)
302 tagOf_PrimOp ChrOp = ILIT( 38)
303 tagOf_PrimOp IntAddOp = ILIT( 39)
304 tagOf_PrimOp IntSubOp = ILIT( 40)
305 tagOf_PrimOp IntMulOp = ILIT( 41)
306 tagOf_PrimOp IntQuotOp = ILIT( 42)
307 tagOf_PrimOp IntRemOp = ILIT( 44)
308 tagOf_PrimOp IntNegOp = ILIT( 45)
309 tagOf_PrimOp IntAbsOp = ILIT( 47)
310 tagOf_PrimOp WordQuotOp = ILIT( 48)
311 tagOf_PrimOp WordRemOp = ILIT( 49)
312 tagOf_PrimOp AndOp = ILIT( 50)
313 tagOf_PrimOp OrOp = ILIT( 51)
314 tagOf_PrimOp NotOp = ILIT( 52)
315 tagOf_PrimOp XorOp = ILIT( 53)
316 tagOf_PrimOp SllOp = ILIT( 54)
317 tagOf_PrimOp SraOp = ILIT( 55)
318 tagOf_PrimOp SrlOp = ILIT( 56)
319 tagOf_PrimOp ISllOp = ILIT( 57)
320 tagOf_PrimOp ISraOp = ILIT( 58)
321 tagOf_PrimOp ISrlOp = ILIT( 59)
322 tagOf_PrimOp Int2WordOp = ILIT( 60)
323 tagOf_PrimOp Word2IntOp = ILIT( 61)
324 tagOf_PrimOp Int2AddrOp = ILIT( 62)
325 tagOf_PrimOp Addr2IntOp = ILIT( 63)
326 tagOf_PrimOp FloatAddOp = ILIT( 64)
327 tagOf_PrimOp FloatSubOp = ILIT( 65)
328 tagOf_PrimOp FloatMulOp = ILIT( 66)
329 tagOf_PrimOp FloatDivOp = ILIT( 67)
330 tagOf_PrimOp FloatNegOp = ILIT( 68)
331 tagOf_PrimOp Float2IntOp = ILIT( 69)
332 tagOf_PrimOp Int2FloatOp = ILIT( 70)
333 tagOf_PrimOp FloatExpOp = ILIT( 71)
334 tagOf_PrimOp FloatLogOp = ILIT( 72)
335 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
336 tagOf_PrimOp FloatSinOp = ILIT( 74)
337 tagOf_PrimOp FloatCosOp = ILIT( 75)
338 tagOf_PrimOp FloatTanOp = ILIT( 76)
339 tagOf_PrimOp FloatAsinOp = ILIT( 77)
340 tagOf_PrimOp FloatAcosOp = ILIT( 78)
341 tagOf_PrimOp FloatAtanOp = ILIT( 79)
342 tagOf_PrimOp FloatSinhOp = ILIT( 80)
343 tagOf_PrimOp FloatCoshOp = ILIT( 81)
344 tagOf_PrimOp FloatTanhOp = ILIT( 82)
345 tagOf_PrimOp FloatPowerOp = ILIT( 83)
346 tagOf_PrimOp DoubleAddOp = ILIT( 84)
347 tagOf_PrimOp DoubleSubOp = ILIT( 85)
348 tagOf_PrimOp DoubleMulOp = ILIT( 86)
349 tagOf_PrimOp DoubleDivOp = ILIT( 87)
350 tagOf_PrimOp DoubleNegOp = ILIT( 88)
351 tagOf_PrimOp Double2IntOp = ILIT( 89)
352 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
353 tagOf_PrimOp Double2FloatOp = ILIT( 91)
354 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
355 tagOf_PrimOp DoubleExpOp = ILIT( 93)
356 tagOf_PrimOp DoubleLogOp = ILIT( 94)
357 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
358 tagOf_PrimOp DoubleSinOp = ILIT( 96)
359 tagOf_PrimOp DoubleCosOp = ILIT( 97)
360 tagOf_PrimOp DoubleTanOp = ILIT( 98)
361 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
362 tagOf_PrimOp DoubleAcosOp = ILIT(100)
363 tagOf_PrimOp DoubleAtanOp = ILIT(101)
364 tagOf_PrimOp DoubleSinhOp = ILIT(102)
365 tagOf_PrimOp DoubleCoshOp = ILIT(103)
366 tagOf_PrimOp DoubleTanhOp = ILIT(104)
367 tagOf_PrimOp DoublePowerOp = ILIT(105)
368 tagOf_PrimOp IntegerAddOp = ILIT(106)
369 tagOf_PrimOp IntegerSubOp = ILIT(107)
370 tagOf_PrimOp IntegerMulOp = ILIT(108)
371 tagOf_PrimOp IntegerQuotRemOp = ILIT(109)
372 tagOf_PrimOp IntegerDivModOp = ILIT(110)
373 tagOf_PrimOp IntegerNegOp = ILIT(111)
374 tagOf_PrimOp IntegerCmpOp = ILIT(112)
375 tagOf_PrimOp Integer2IntOp = ILIT(113)
376 tagOf_PrimOp Integer2WordOp = ILIT(114)
377 tagOf_PrimOp Int2IntegerOp = ILIT(115)
378 tagOf_PrimOp Word2IntegerOp = ILIT(116)
379 tagOf_PrimOp Addr2IntegerOp = ILIT(117)
380 tagOf_PrimOp FloatEncodeOp = ILIT(118)
381 tagOf_PrimOp FloatDecodeOp = ILIT(119)
382 tagOf_PrimOp DoubleEncodeOp = ILIT(120)
383 tagOf_PrimOp DoubleDecodeOp = ILIT(121)
384 tagOf_PrimOp NewArrayOp = ILIT(122)
385 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(123)
386 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(124)
387 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(125)
388 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(126)
389 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(127)
390 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(128)
391 tagOf_PrimOp SameMutableArrayOp = ILIT(129)
392 tagOf_PrimOp SameMutableByteArrayOp = ILIT(130)
393 tagOf_PrimOp ReadArrayOp = ILIT(131)
394 tagOf_PrimOp WriteArrayOp = ILIT(132)
395 tagOf_PrimOp IndexArrayOp = ILIT(133)
396 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(134)
397 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(135)
398 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(136)
399 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(137)
400 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(138)
401 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(139)
402 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(140)
403 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(141)
404 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(142)
405 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(143)
406 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(144)
407 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(145)
408 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(146)
409 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(147)
410 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(148)
411 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(149)
412 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(150)
413 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(151)
414 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(152)
415 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(153)
416 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(154)
417 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(155)
418 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(156)
419 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(157)
420 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(158)
421 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(159)
422 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(160)
423 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(161)
424 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(162)
425 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(163)
426 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(164)
427 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(165)
428 tagOf_PrimOp SizeofByteArrayOp = ILIT(166)
429 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(167)
430 tagOf_PrimOp NewSynchVarOp = ILIT(168)
431 tagOf_PrimOp TakeMVarOp = ILIT(169)
432 tagOf_PrimOp PutMVarOp = ILIT(170)
433 tagOf_PrimOp ReadIVarOp = ILIT(171)
434 tagOf_PrimOp WriteIVarOp = ILIT(172)
435 tagOf_PrimOp MakeForeignObjOp = ILIT(173)
436 tagOf_PrimOp WriteForeignObjOp = ILIT(174)
437 tagOf_PrimOp MakeStablePtrOp = ILIT(175)
438 tagOf_PrimOp DeRefStablePtrOp = ILIT(176)
439 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(177)
440 tagOf_PrimOp ErrorIOPrimOp = ILIT(178)
441 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(179)
442 tagOf_PrimOp SeqOp = ILIT(180)
443 tagOf_PrimOp ParOp = ILIT(181)
444 tagOf_PrimOp ForkOp = ILIT(182)
445 tagOf_PrimOp DelayOp = ILIT(183)
446 tagOf_PrimOp WaitReadOp = ILIT(184)
447 tagOf_PrimOp WaitWriteOp = ILIT(185)
448 tagOf_PrimOp ParGlobalOp = ILIT(186)
449 tagOf_PrimOp ParLocalOp = ILIT(187)
450 tagOf_PrimOp ParAtOp = ILIT(188)
451 tagOf_PrimOp ParAtAbsOp = ILIT(189)
452 tagOf_PrimOp ParAtRelOp = ILIT(190)
453 tagOf_PrimOp ParAtForNowOp = ILIT(191)
454 tagOf_PrimOp CopyableOp = ILIT(192)
455 tagOf_PrimOp NoFollowOp = ILIT(193)
457 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
459 instance Eq PrimOp where
460 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
463 An @Enum@-derived list would be better; meanwhile... (ToDo)
585 NewByteArrayOp CharRep,
586 NewByteArrayOp IntRep,
587 NewByteArrayOp WordRep,
588 NewByteArrayOp AddrRep,
589 NewByteArrayOp FloatRep,
590 NewByteArrayOp DoubleRep,
592 SameMutableByteArrayOp,
596 ReadByteArrayOp CharRep,
597 ReadByteArrayOp IntRep,
598 ReadByteArrayOp WordRep,
599 ReadByteArrayOp AddrRep,
600 ReadByteArrayOp FloatRep,
601 ReadByteArrayOp DoubleRep,
602 WriteByteArrayOp CharRep,
603 WriteByteArrayOp IntRep,
604 WriteByteArrayOp WordRep,
605 WriteByteArrayOp AddrRep,
606 WriteByteArrayOp FloatRep,
607 WriteByteArrayOp DoubleRep,
608 IndexByteArrayOp CharRep,
609 IndexByteArrayOp IntRep,
610 IndexByteArrayOp WordRep,
611 IndexByteArrayOp AddrRep,
612 IndexByteArrayOp FloatRep,
613 IndexByteArrayOp DoubleRep,
614 IndexOffAddrOp CharRep,
615 IndexOffAddrOp IntRep,
616 IndexOffAddrOp WordRep,
617 IndexOffAddrOp AddrRep,
618 IndexOffAddrOp FloatRep,
619 IndexOffAddrOp DoubleRep,
620 IndexOffForeignObjOp CharRep,
621 IndexOffForeignObjOp IntRep,
622 IndexOffForeignObjOp WordRep,
623 IndexOffForeignObjOp AddrRep,
624 IndexOffForeignObjOp FloatRep,
625 IndexOffForeignObjOp DoubleRep,
627 UnsafeFreezeByteArrayOp,
629 SizeofMutableByteArrayOp,
640 ReallyUnsafePtrEqualityOp,
659 %************************************************************************
661 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
663 %************************************************************************
665 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
666 refer to the primitive operation. The conventional \tr{#}-for-
667 unboxed ops is added on later.
669 The reason for the funny characters in the names is so we do not
670 interfere with the programmer's Haskell name spaces.
672 We use @PrimKinds@ for the ``type'' information, because they're
673 (slightly) more convenient to use than @TyCons@.
676 = Dyadic FAST_STRING -- string :: T -> T -> T
678 | Monadic FAST_STRING -- string :: T -> T
680 | Compare FAST_STRING -- string :: T -> T -> Bool
682 | Coercing FAST_STRING -- string :: T1 -> T2
686 | PrimResult FAST_STRING
687 [TyVar] [Type] TyCon PrimRep [Type]
688 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
689 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
690 -- D# is a primitive type constructor.
691 -- (the kind is the same info as D#, in another convenient form)
693 | AlgResult FAST_STRING
694 [TyVar] [Type] TyCon [Type]
695 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
696 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
698 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
703 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
705 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
706 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
707 an_Integer_and_Int_tys
708 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
711 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
713 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
715 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
717 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
720 @primOpInfo@ gives all essential information (from which everything
721 else, notably a type, can be constructed) for each @PrimOp@.
724 primOpInfo :: PrimOp -> PrimOpInfo
727 There's plenty of this stuff!
729 %************************************************************************
731 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
733 %************************************************************************
736 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
737 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
738 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
739 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
740 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
741 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
743 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
744 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
745 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
746 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
747 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
748 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
750 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
751 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
752 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
753 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
754 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
755 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
757 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
758 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
759 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
760 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
761 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
762 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
764 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
765 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
766 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
767 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
768 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
769 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
771 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
772 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
773 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
774 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
775 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
776 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
779 %************************************************************************
781 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
783 %************************************************************************
786 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
787 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
790 %************************************************************************
792 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
794 %************************************************************************
797 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
798 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
799 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
800 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
801 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
803 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
804 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
807 %************************************************************************
809 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
811 %************************************************************************
813 A @Word#@ is an unsigned @Int#@.
816 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
817 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
819 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
820 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
821 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
822 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
825 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
827 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
829 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
832 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
834 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
836 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
838 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
839 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
842 %************************************************************************
844 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
846 %************************************************************************
849 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
850 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
853 %************************************************************************
855 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
857 %************************************************************************
859 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
863 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
864 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
865 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
866 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
867 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
869 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
870 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
872 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
873 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
874 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
875 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
876 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
877 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
878 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
879 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
880 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
881 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
882 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
883 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
884 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
887 %************************************************************************
889 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
891 %************************************************************************
893 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
897 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
898 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
899 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
900 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
901 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
903 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
904 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
906 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
907 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
909 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
910 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
911 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
912 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
913 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
914 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
915 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
916 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
917 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
918 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
919 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
920 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
921 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
924 %************************************************************************
926 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
928 %************************************************************************
931 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
933 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
934 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
935 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
937 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
939 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
940 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
942 primOpInfo Integer2IntOp
943 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
945 primOpInfo Integer2WordOp
946 = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
948 primOpInfo Int2IntegerOp
949 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
951 primOpInfo Word2IntegerOp
952 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
954 primOpInfo Addr2IntegerOp
955 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
958 Encoding and decoding of floating-point numbers is sorta
962 primOpInfo FloatEncodeOp
963 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
964 floatPrimTyCon FloatRep []
966 primOpInfo DoubleEncodeOp
967 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
968 doublePrimTyCon DoubleRep []
970 primOpInfo FloatDecodeOp
971 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
973 primOpInfo DoubleDecodeOp
974 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
977 %************************************************************************
979 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
981 %************************************************************************
984 primOpInfo NewArrayOp
986 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
988 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
989 stateAndMutableArrayPrimTyCon [s, elt]
991 primOpInfo (NewByteArrayOp kind)
993 s = alphaTy; s_tv = alphaTyVar
995 (str, _, prim_tycon) = getPrimRepInfo kind
997 op_str = _PK_ ("new" ++ str ++ "Array#")
999 AlgResult op_str [s_tv]
1000 [intPrimTy, mkStatePrimTy s]
1001 stateAndMutableByteArrayPrimTyCon [s]
1003 ---------------------------------------------------------------------------
1005 primOpInfo SameMutableArrayOp
1007 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1008 mut_arr_ty = mkMutableArrayPrimTy s elt
1010 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1013 primOpInfo SameMutableByteArrayOp
1015 s = alphaTy; s_tv = alphaTyVar;
1016 mut_arr_ty = mkMutableByteArrayPrimTy s
1018 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1021 ---------------------------------------------------------------------------
1022 -- Primitive arrays of Haskell pointers:
1024 primOpInfo ReadArrayOp
1026 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1028 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1029 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1030 stateAndPtrPrimTyCon [s, elt]
1033 primOpInfo WriteArrayOp
1035 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1037 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1038 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1039 statePrimTyCon VoidRep [s]
1041 primOpInfo IndexArrayOp
1042 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1043 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1046 ---------------------------------------------------------------------------
1047 -- Primitive arrays full of unboxed bytes:
1049 primOpInfo (ReadByteArrayOp kind)
1051 s = alphaTy; s_tv = alphaTyVar
1053 (str, _, prim_tycon) = getPrimRepInfo kind
1055 op_str = _PK_ ("read" ++ str ++ "Array#")
1056 relevant_tycon = assoc "primOpInfo" tbl kind
1058 AlgResult op_str [s_tv]
1059 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1062 tbl = [ (CharRep, stateAndCharPrimTyCon),
1063 (IntRep, stateAndIntPrimTyCon),
1064 (WordRep, stateAndWordPrimTyCon),
1065 (AddrRep, stateAndAddrPrimTyCon),
1066 (FloatRep, stateAndFloatPrimTyCon),
1067 (DoubleRep, stateAndDoublePrimTyCon) ]
1069 -- How come there's no Word byte arrays? ADR
1071 primOpInfo (WriteByteArrayOp kind)
1073 s = alphaTy; s_tv = alphaTyVar
1075 (str, prim_ty, _) = getPrimRepInfo kind
1076 op_str = _PK_ ("write" ++ str ++ "Array#")
1078 -- NB: *Prim*Result --
1079 PrimResult op_str [s_tv]
1080 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1081 statePrimTyCon VoidRep [s]
1083 primOpInfo (IndexByteArrayOp kind)
1085 (str, _, prim_tycon) = getPrimRepInfo kind
1086 op_str = _PK_ ("index" ++ str ++ "Array#")
1088 -- NB: *Prim*Result --
1089 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1091 primOpInfo (IndexOffAddrOp kind)
1093 (str, _, prim_tycon) = getPrimRepInfo kind
1094 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1096 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1098 primOpInfo (IndexOffForeignObjOp kind)
1100 (str, _, prim_tycon) = getPrimRepInfo kind
1101 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1103 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1105 ---------------------------------------------------------------------------
1106 primOpInfo UnsafeFreezeArrayOp
1108 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1110 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1111 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1112 stateAndArrayPrimTyCon [s, elt]
1114 primOpInfo UnsafeFreezeByteArrayOp
1115 = let { s = alphaTy; s_tv = alphaTyVar } in
1116 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1117 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1118 stateAndByteArrayPrimTyCon [s]
1119 ---------------------------------------------------------------------------
1120 primOpInfo SizeofByteArrayOp
1122 SLIT("sizeofByteArray#") []
1124 intPrimTyCon IntRep []
1126 primOpInfo SizeofMutableByteArrayOp
1127 = let { s = alphaTy; s_tv = alphaTyVar } in
1129 SLIT("sizeofMutableByteArray#") [s_tv]
1130 [mkMutableByteArrayPrimTy s]
1131 intPrimTyCon IntRep []
1135 %************************************************************************
1137 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1139 %************************************************************************
1142 primOpInfo NewSynchVarOp
1144 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1146 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1147 stateAndSynchVarPrimTyCon [s, elt]
1149 primOpInfo TakeMVarOp
1151 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1153 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1154 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1155 stateAndPtrPrimTyCon [s, elt]
1157 primOpInfo PutMVarOp
1159 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1161 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1162 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1165 primOpInfo ReadIVarOp
1167 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1169 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1170 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1171 stateAndPtrPrimTyCon [s, elt]
1173 primOpInfo WriteIVarOp
1175 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1177 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1178 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1183 %************************************************************************
1185 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1187 %************************************************************************
1193 s = alphaTy; s_tv = alphaTyVar
1195 PrimResult SLIT("delay#") [s_tv]
1196 [intPrimTy, mkStatePrimTy s]
1197 statePrimTyCon VoidRep [s]
1199 primOpInfo WaitReadOp
1201 s = alphaTy; s_tv = alphaTyVar
1203 PrimResult SLIT("waitRead#") [s_tv]
1204 [intPrimTy, mkStatePrimTy s]
1205 statePrimTyCon VoidRep [s]
1207 primOpInfo WaitWriteOp
1209 s = alphaTy; s_tv = alphaTyVar
1211 PrimResult SLIT("waitWrite#") [s_tv]
1212 [intPrimTy, mkStatePrimTy s]
1213 statePrimTyCon VoidRep [s]
1216 %************************************************************************
1218 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1220 %************************************************************************
1222 Not everything should/can be in the Haskell heap. As an example, in an
1223 image processing application written in Haskell, you really would like
1224 to avoid heaving huge images between different space or generations of
1225 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1226 which refer to some externally allocated structure/value. Using @ForeignObj@,
1227 just a reference to an image is present in the heap, the image could then
1228 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1229 a completely separate address space alltogether.
1231 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1232 associated with the object is invoked (currently, each ForeignObj has a
1233 direct reference to its finaliser). -- SOF
1235 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1238 makeForeignObj# :: Addr# -- foreign object
1239 -> Addr# -- ptr to its finaliser routine
1240 -> StateAndForeignObj# _RealWorld# ForeignObj#
1245 primOpInfo MakeForeignObjOp
1246 = AlgResult SLIT("makeForeignObj#") []
1247 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1248 stateAndForeignObjPrimTyCon [realWorldTy]
1252 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1253 the external object wrapped up inside a @ForeignObj@. This primitive is used
1254 when a mixed programming interface of implicit and explicit de-allocation is used,
1255 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1256 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1257 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1258 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1259 We deal with this situation, by allowing the programmer to destructively modify
1260 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1261 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1264 writeForeignObj# :: ForeignObj# -- foreign object
1265 -> Addr# -- new data value
1266 -> StateAndForeignObj# _RealWorld# ForeignObj#
1270 primOpInfo WriteForeignObjOp
1272 s = alphaTy; s_tv = alphaTyVar
1274 PrimResult SLIT("writeForeignObj#") [s_tv]
1275 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1276 statePrimTyCon VoidRep [s]
1279 %************************************************************************
1281 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1283 %************************************************************************
1285 A {\em stable pointer} is an index into a table of pointers into the
1286 heap. Since the garbage collector is told about stable pointers, it
1287 is safe to pass a stable pointer to external systems such as C
1290 Here's what the operations and types are supposed to be (from
1291 state-interface document).
1294 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1295 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1296 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1299 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1300 operation since it doesn't (directly) involve IO operations. The
1301 reason is that if some optimisation pass decided to duplicate calls to
1302 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1303 massive space leak can result. Putting it into the PrimIO monad
1304 prevents this. (Another reason for putting them in a monad is to
1305 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1308 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1309 besides, it's not likely to be used from Haskell) so it's not a
1312 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1315 primOpInfo MakeStablePtrOp
1316 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1317 [alphaTy, realWorldStatePrimTy]
1318 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1320 primOpInfo DeRefStablePtrOp
1321 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1322 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1323 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1326 %************************************************************************
1328 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1330 %************************************************************************
1332 [Alastair Reid is to blame for this!]
1334 These days, (Glasgow) Haskell seems to have a bit of everything from
1335 other languages: strict operations, mutable variables, sequencing,
1336 pointers, etc. About the only thing left is LISP's ability to test
1337 for pointer equality. So, let's add it in!
1340 reallyUnsafePtrEquality :: a -> a -> Int#
1343 which tests any two closures (of the same type) to see if they're the
1344 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1345 difficulties of trying to box up the result.)
1347 NB This is {\em really unsafe\/} because even something as trivial as
1348 a garbage collection might change the answer by removing indirections.
1349 Still, no-one's forcing you to use it. If you're worried about little
1350 things like loss of referential transparency, you might like to wrap
1351 it all up in a monad-like thing as John O'Donnell and John Hughes did
1352 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1355 I'm thinking of using it to speed up a critical equality test in some
1356 graphics stuff in a context where the possibility of saying that
1357 denotationally equal things aren't isn't a problem (as long as it
1358 doesn't happen too often.) ADR
1360 To Will: Jim said this was already in, but I can't see it so I'm
1361 adding it. Up to you whether you add it. (Note that this could have
1362 been readily implemented using a @veryDangerousCCall@ before they were
1366 primOpInfo ReallyUnsafePtrEqualityOp
1367 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1368 [alphaTy, alphaTy] intPrimTyCon IntRep []
1371 %************************************************************************
1373 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1375 %************************************************************************
1378 primOpInfo SeqOp -- seq# :: a -> Int#
1379 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1381 primOpInfo ParOp -- par# :: a -> Int#
1382 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1384 primOpInfo ForkOp -- fork# :: a -> Int#
1385 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1390 -- HWL: The first 4 Int# in all par... annotations denote:
1391 -- name, granularity info, size of result, degree of parallelism
1392 -- Same structure as _seq_ i.e. returns Int#
1394 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1395 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1397 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1398 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1400 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1401 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1403 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1404 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1406 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1407 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1409 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1410 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1412 primOpInfo CopyableOp -- copyable# :: a -> a
1413 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1415 primOpInfo NoFollowOp -- noFollow# :: a -> a
1416 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1419 %************************************************************************
1421 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1423 %************************************************************************
1426 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1427 primOpInfo ErrorIOPrimOp
1428 = PrimResult SLIT("errorIO#") [alphaTyVar]
1429 [mkFunTy realWorldStatePrimTy alphaTy]
1430 statePrimTyCon VoidRep [realWorldTy]
1433 %************************************************************************
1435 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1437 %************************************************************************
1440 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1441 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1443 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1446 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1450 %************************************************************************
1452 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1454 %************************************************************************
1456 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1457 with @Integers@ can trigger GC. Here we describe the heap requirements
1458 of the various @PrimOps@. For most, no heap is required. For a few,
1459 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1460 be combined with the rest of the heap usage in the basic block. For an
1461 unfortunate few, some unknown amount of heap is required (these are the
1462 ops which can trigger GC).
1465 data HeapRequirement
1467 | FixedHeapRequired HeapOffset
1468 | VariableHeapRequired
1470 primOpHeapReq :: PrimOp -> HeapRequirement
1472 primOpHeapReq NewArrayOp = VariableHeapRequired
1473 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1475 primOpHeapReq IntegerAddOp = VariableHeapRequired
1476 primOpHeapReq IntegerSubOp = VariableHeapRequired
1477 primOpHeapReq IntegerMulOp = VariableHeapRequired
1478 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1479 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1480 primOpHeapReq IntegerNegOp = VariableHeapRequired
1481 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1482 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1483 (intOff mIN_MP_INT_SIZE))
1484 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1485 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1486 (intOff mIN_MP_INT_SIZE))
1487 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1488 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1489 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1490 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1491 (intOff mIN_MP_INT_SIZE)))
1492 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1493 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1494 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1495 (intOff mIN_MP_INT_SIZE)))
1498 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1499 or if it returns a ForeignObj.
1501 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1502 why do we need to be so indeterminate about it? --SOF
1504 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1505 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1507 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1508 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1510 -- this occasionally has to expand the Stable Pointer table
1511 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1513 -- These four only need heap space with the native code generator
1514 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1516 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1517 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1518 primOpHeapReq Integer2WordOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1519 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1520 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1522 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1523 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1524 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1526 -- Sparking ops no longer allocate any heap; however, _fork_ may
1527 -- require a context switch to clear space in the required thread
1528 -- pool, and that requires liveness information.
1530 primOpHeapReq ParOp = NoHeapRequired
1531 primOpHeapReq ForkOp = VariableHeapRequired
1533 -- A SeqOp requires unknown space to evaluate its argument
1534 primOpHeapReq SeqOp = VariableHeapRequired
1536 -- GranSim sparks are stgMalloced i.e. no heap required
1537 primOpHeapReq ParGlobalOp = NoHeapRequired
1538 primOpHeapReq ParLocalOp = NoHeapRequired
1539 primOpHeapReq ParAtOp = NoHeapRequired
1540 primOpHeapReq ParAtAbsOp = NoHeapRequired
1541 primOpHeapReq ParAtRelOp = NoHeapRequired
1542 primOpHeapReq ParAtForNowOp = NoHeapRequired
1543 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1544 primOpHeapReq CopyableOp = NoHeapRequired
1545 primOpHeapReq NoFollowOp = NoHeapRequired
1547 primOpHeapReq other_op = NoHeapRequired
1550 The amount of stack required by primops.
1553 data StackRequirement
1555 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1556 | VariableStackRequired
1558 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1559 primOpStackRequired _ = VariableStackRequired
1560 -- ToDo: be more specific for certain primops (currently only used for seq)
1563 Primops which can trigger GC have to be called carefully.
1564 In particular, their arguments are guaranteed to be in registers,
1565 and a liveness mask tells which regs are live.
1568 primOpCanTriggerGC op
1576 case primOpHeapReq op of
1577 VariableHeapRequired -> True
1581 Sometimes we may choose to execute a PrimOp even though it isn't
1582 certain that its result will be required; ie execute them
1583 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1584 this is OK, because PrimOps are usually cheap, but it isn't OK for
1585 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1587 See also @primOpIsCheap@ (below).
1589 There should be no worries about side effects; that's all taken care
1590 of by data dependencies.
1593 primOpOkForSpeculation :: PrimOp -> Bool
1596 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1597 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1600 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1601 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1603 -- Float. ToDo: tan? tanh?
1604 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1605 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1606 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1607 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1609 -- Double. ToDo: tan? tanh?
1610 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1611 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1612 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1613 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1616 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1619 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1622 primOpOkForSpeculation ParOp = False -- Could be expensive!
1623 primOpOkForSpeculation ForkOp = False -- Likewise
1624 primOpOkForSpeculation SeqOp = False -- Likewise
1626 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1627 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1628 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1629 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1630 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1631 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1632 primOpOkForSpeculation CopyableOp = False -- only tags closure
1633 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1635 -- The default is "yes it's ok for speculation"
1636 primOpOkForSpeculation other_op = True
1639 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1640 WARNING), we just borrow some other predicates for a
1641 what-should-be-good-enough test.
1644 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1647 And some primops have side-effects and so, for example, must not be
1651 fragilePrimOp :: PrimOp -> Bool
1653 fragilePrimOp ParOp = True
1654 fragilePrimOp ForkOp = True
1655 fragilePrimOp SeqOp = True
1656 fragilePrimOp MakeForeignObjOp = True -- SOF
1657 fragilePrimOp WriteForeignObjOp = True -- SOF
1658 fragilePrimOp MakeStablePtrOp = True
1659 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1661 fragilePrimOp ParGlobalOp = True
1662 fragilePrimOp ParLocalOp = True
1663 fragilePrimOp ParAtOp = True
1664 fragilePrimOp ParAtAbsOp = True
1665 fragilePrimOp ParAtRelOp = True
1666 fragilePrimOp ParAtForNowOp = True
1667 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1668 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1670 fragilePrimOp other = False
1673 Primitive operations that perform calls need wrappers to save any live variables
1674 that are stored in caller-saves registers
1677 primOpNeedsWrapper :: PrimOp -> Bool
1679 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1681 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1682 primOpNeedsWrapper (NewByteArrayOp _) = True
1684 primOpNeedsWrapper IntegerAddOp = True
1685 primOpNeedsWrapper IntegerSubOp = True
1686 primOpNeedsWrapper IntegerMulOp = True
1687 primOpNeedsWrapper IntegerQuotRemOp = True
1688 primOpNeedsWrapper IntegerDivModOp = True
1689 primOpNeedsWrapper IntegerNegOp = True
1690 primOpNeedsWrapper IntegerCmpOp = True
1691 primOpNeedsWrapper Integer2IntOp = True
1692 primOpNeedsWrapper Integer2WordOp = True
1693 primOpNeedsWrapper Int2IntegerOp = True
1694 primOpNeedsWrapper Word2IntegerOp = True
1695 primOpNeedsWrapper Addr2IntegerOp = True
1697 primOpNeedsWrapper FloatExpOp = True
1698 primOpNeedsWrapper FloatLogOp = True
1699 primOpNeedsWrapper FloatSqrtOp = True
1700 primOpNeedsWrapper FloatSinOp = True
1701 primOpNeedsWrapper FloatCosOp = True
1702 primOpNeedsWrapper FloatTanOp = True
1703 primOpNeedsWrapper FloatAsinOp = True
1704 primOpNeedsWrapper FloatAcosOp = True
1705 primOpNeedsWrapper FloatAtanOp = True
1706 primOpNeedsWrapper FloatSinhOp = True
1707 primOpNeedsWrapper FloatCoshOp = True
1708 primOpNeedsWrapper FloatTanhOp = True
1709 primOpNeedsWrapper FloatPowerOp = True
1710 primOpNeedsWrapper FloatEncodeOp = True
1711 primOpNeedsWrapper FloatDecodeOp = True
1713 primOpNeedsWrapper DoubleExpOp = True
1714 primOpNeedsWrapper DoubleLogOp = True
1715 primOpNeedsWrapper DoubleSqrtOp = True
1716 primOpNeedsWrapper DoubleSinOp = True
1717 primOpNeedsWrapper DoubleCosOp = True
1718 primOpNeedsWrapper DoubleTanOp = True
1719 primOpNeedsWrapper DoubleAsinOp = True
1720 primOpNeedsWrapper DoubleAcosOp = True
1721 primOpNeedsWrapper DoubleAtanOp = True
1722 primOpNeedsWrapper DoubleSinhOp = True
1723 primOpNeedsWrapper DoubleCoshOp = True
1724 primOpNeedsWrapper DoubleTanhOp = True
1725 primOpNeedsWrapper DoublePowerOp = True
1726 primOpNeedsWrapper DoubleEncodeOp = True
1727 primOpNeedsWrapper DoubleDecodeOp = True
1729 primOpNeedsWrapper MakeForeignObjOp = True
1730 primOpNeedsWrapper WriteForeignObjOp = True
1731 primOpNeedsWrapper MakeStablePtrOp = True
1732 primOpNeedsWrapper DeRefStablePtrOp = True
1734 primOpNeedsWrapper TakeMVarOp = True
1735 primOpNeedsWrapper PutMVarOp = True
1736 primOpNeedsWrapper ReadIVarOp = True
1738 primOpNeedsWrapper DelayOp = True
1739 primOpNeedsWrapper WaitReadOp = True
1740 primOpNeedsWrapper WaitWriteOp = True
1742 primOpNeedsWrapper other_op = False
1747 = case (primOpInfo op) of
1749 Monadic str _ -> str
1750 Compare str _ -> str
1751 Coercing str _ _ -> str
1752 PrimResult str _ _ _ _ _ -> str
1753 AlgResult str _ _ _ _ -> str
1756 @primOpType@ duplicates some work of @primOpId@, but since we
1757 grab types pretty often...
1759 primOpType :: PrimOp -> Type
1762 = case (primOpInfo op) of
1763 Dyadic str ty -> dyadic_fun_ty ty
1764 Monadic str ty -> monadic_fun_ty ty
1765 Compare str ty -> compare_fun_ty ty
1766 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1768 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1769 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1771 AlgResult str tyvars arg_tys tycon res_tys ->
1772 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1776 data PrimOpResultInfo
1777 = ReturnsPrim PrimRep
1780 -- ToDo: Deal with specialised PrimOps
1781 -- Will need to return specialised tycon and data constructors
1783 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1785 getPrimOpResultInfo op
1786 = case (primOpInfo op) of
1787 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1788 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1789 Compare _ ty -> ReturnsAlg boolTyCon
1790 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1791 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1792 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1794 isCompareOp :: PrimOp -> Bool
1797 = case primOpInfo op of
1802 The commutable ops are those for which we will try to move constants
1803 to the right hand side for strength reduction.
1806 commutableOp :: PrimOp -> Bool
1808 commutableOp CharEqOp = True
1809 commutableOp CharNeOp = True
1810 commutableOp IntAddOp = True
1811 commutableOp IntMulOp = True
1812 commutableOp AndOp = True
1813 commutableOp OrOp = True
1814 commutableOp XorOp = True
1815 commutableOp IntEqOp = True
1816 commutableOp IntNeOp = True
1817 commutableOp IntegerAddOp = True
1818 commutableOp IntegerMulOp = True
1819 commutableOp FloatAddOp = True
1820 commutableOp FloatMulOp = True
1821 commutableOp FloatEqOp = True
1822 commutableOp FloatNeOp = True
1823 commutableOp DoubleAddOp = True
1824 commutableOp DoubleMulOp = True
1825 commutableOp DoubleEqOp = True
1826 commutableOp DoubleNeOp = True
1827 commutableOp _ = False
1832 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1833 monadic_fun_ty ty = mkFunTy ty ty
1834 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1839 pprPrimOp :: PrimOp -> SDoc
1840 showPrimOp :: PrimOp -> String
1842 showPrimOp op = showSDoc (pprPrimOp op)
1844 pprPrimOp (CCallOp fun is_casm may_gc arg_tys res_ty)
1848 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1850 if may_gc then "_ccall_GC_ " else "_ccall_ "
1853 = if is_casm then text "''" else empty
1856 = hsep (map pprParendType (res_ty:arg_tys))
1858 hcat [text before, ptext fun, after, space, brackets pp_tys]
1861 = getPprStyle $ \ sty ->
1862 if codeStyle sty then -- For C just print the primop itself
1864 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1865 ptext SLIT("PrelGHC.") <> ptext str
1866 else -- Unqualified is good enough
1869 str = primOp_str other_op
1872 instance Outputable PrimOp where
1873 ppr op = pprPrimOp op