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 ( pprParendGenType, GenTyVar{-instance Outputable-} )
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, GenTyVar{-instance Eq-} )
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
154 | NewSynchVarOp -- for MVars and IVars
155 | TakeMVarOp | PutMVarOp
156 | ReadIVarOp | WriteIVarOp
158 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
159 | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
160 | MakeStablePtrOp | DeRefStablePtrOp
163 A special ``trap-door'' to use in making calls direct to C functions:
165 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
166 Bool -- True <=> really a "casm"
167 Bool -- True <=> might invoke Haskell GC
168 [Type] -- Unboxed argument; the state-token
169 -- argument will have been put *first*
170 Type -- Return type; one of the "StateAnd<blah>#" types
172 -- (... to be continued ... )
175 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
176 (See @primOpInfo@ for details.)
178 Note: that first arg and part of the result should be the system state
179 token (which we carry around to fool over-zealous optimisers) but
180 which isn't actually passed.
182 For example, we represent
184 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
190 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
191 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
195 (AlgAlts [ ( FloatPrimAndIoWorld,
197 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
203 Nota Bene: there are some people who find the empty list of types in
204 the @Prim@ somewhat puzzling and would represent the above by
208 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
209 -- :: /\ alpha1, alpha2 alpha3, alpha4.
210 -- alpha1 -> alpha2 -> alpha3 -> alpha4
211 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
214 (AlgAlts [ ( FloatPrimAndIoWorld,
216 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
222 But, this is a completely different way of using @CCallOp@. The most
223 major changes required if we switch to this are in @primOpInfo@, and
224 the desugarer. The major difficulty is in moving the HeapRequirement
225 stuff somewhere appropriate. (The advantage is that we could simplify
226 @CCallOp@ and record just the number of arguments with corresponding
227 simplifications in reading pragma unfoldings, the simplifier,
228 instantiation (etc) of core expressions, ... . Maybe we should think
229 about using it this way?? ADR)
232 -- (... continued from above ... )
234 -- one to support "errorIO" (and, thereby, "error")
237 -- Operation to test two closure addresses for equality (yes really!)
238 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
239 | ReallyUnsafePtrEqualityOp
241 -- three for parallel stuff
246 -- three for concurrency
251 | ParGlobalOp -- named global par
252 | ParLocalOp -- named local par
253 | ParAtOp -- specifies destination of local par
254 | ParAtAbsOp -- specifies destination of local par (abs processor)
255 | ParAtRelOp -- specifies destination of local par (rel processor)
256 | ParAtForNowOp -- specifies initial destination of global par
257 | CopyableOp -- marks copyable code
258 | NoFollowOp -- marks non-followup expression
261 Deriving Ix is what we really want! ToDo
262 (Chk around before deleting...)
264 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
265 tagOf_PrimOp CharGeOp = ILIT( 2)
266 tagOf_PrimOp CharEqOp = ILIT( 3)
267 tagOf_PrimOp CharNeOp = ILIT( 4)
268 tagOf_PrimOp CharLtOp = ILIT( 5)
269 tagOf_PrimOp CharLeOp = ILIT( 6)
270 tagOf_PrimOp IntGtOp = ILIT( 7)
271 tagOf_PrimOp IntGeOp = ILIT( 8)
272 tagOf_PrimOp IntEqOp = ILIT( 9)
273 tagOf_PrimOp IntNeOp = ILIT( 10)
274 tagOf_PrimOp IntLtOp = ILIT( 11)
275 tagOf_PrimOp IntLeOp = ILIT( 12)
276 tagOf_PrimOp WordGtOp = ILIT( 13)
277 tagOf_PrimOp WordGeOp = ILIT( 14)
278 tagOf_PrimOp WordEqOp = ILIT( 15)
279 tagOf_PrimOp WordNeOp = ILIT( 16)
280 tagOf_PrimOp WordLtOp = ILIT( 17)
281 tagOf_PrimOp WordLeOp = ILIT( 18)
282 tagOf_PrimOp AddrGtOp = ILIT( 19)
283 tagOf_PrimOp AddrGeOp = ILIT( 20)
284 tagOf_PrimOp AddrEqOp = ILIT( 21)
285 tagOf_PrimOp AddrNeOp = ILIT( 22)
286 tagOf_PrimOp AddrLtOp = ILIT( 23)
287 tagOf_PrimOp AddrLeOp = ILIT( 24)
288 tagOf_PrimOp FloatGtOp = ILIT( 25)
289 tagOf_PrimOp FloatGeOp = ILIT( 26)
290 tagOf_PrimOp FloatEqOp = ILIT( 27)
291 tagOf_PrimOp FloatNeOp = ILIT( 28)
292 tagOf_PrimOp FloatLtOp = ILIT( 29)
293 tagOf_PrimOp FloatLeOp = ILIT( 30)
294 tagOf_PrimOp DoubleGtOp = ILIT( 31)
295 tagOf_PrimOp DoubleGeOp = ILIT( 32)
296 tagOf_PrimOp DoubleEqOp = ILIT( 33)
297 tagOf_PrimOp DoubleNeOp = ILIT( 34)
298 tagOf_PrimOp DoubleLtOp = ILIT( 35)
299 tagOf_PrimOp DoubleLeOp = ILIT( 36)
300 tagOf_PrimOp OrdOp = ILIT( 37)
301 tagOf_PrimOp ChrOp = ILIT( 38)
302 tagOf_PrimOp IntAddOp = ILIT( 39)
303 tagOf_PrimOp IntSubOp = ILIT( 40)
304 tagOf_PrimOp IntMulOp = ILIT( 41)
305 tagOf_PrimOp IntQuotOp = ILIT( 42)
306 tagOf_PrimOp IntRemOp = ILIT( 44)
307 tagOf_PrimOp IntNegOp = ILIT( 45)
308 tagOf_PrimOp IntAbsOp = ILIT( 47)
309 tagOf_PrimOp WordQuotOp = ILIT( 48)
310 tagOf_PrimOp WordRemOp = ILIT( 49)
311 tagOf_PrimOp AndOp = ILIT( 50)
312 tagOf_PrimOp OrOp = ILIT( 51)
313 tagOf_PrimOp NotOp = ILIT( 52)
314 tagOf_PrimOp XorOp = ILIT( 53)
315 tagOf_PrimOp SllOp = ILIT( 54)
316 tagOf_PrimOp SraOp = ILIT( 55)
317 tagOf_PrimOp SrlOp = ILIT( 56)
318 tagOf_PrimOp ISllOp = ILIT( 57)
319 tagOf_PrimOp ISraOp = ILIT( 58)
320 tagOf_PrimOp ISrlOp = ILIT( 59)
321 tagOf_PrimOp Int2WordOp = ILIT( 60)
322 tagOf_PrimOp Word2IntOp = ILIT( 61)
323 tagOf_PrimOp Int2AddrOp = ILIT( 62)
324 tagOf_PrimOp Addr2IntOp = ILIT( 63)
325 tagOf_PrimOp FloatAddOp = ILIT( 64)
326 tagOf_PrimOp FloatSubOp = ILIT( 65)
327 tagOf_PrimOp FloatMulOp = ILIT( 66)
328 tagOf_PrimOp FloatDivOp = ILIT( 67)
329 tagOf_PrimOp FloatNegOp = ILIT( 68)
330 tagOf_PrimOp Float2IntOp = ILIT( 69)
331 tagOf_PrimOp Int2FloatOp = ILIT( 70)
332 tagOf_PrimOp FloatExpOp = ILIT( 71)
333 tagOf_PrimOp FloatLogOp = ILIT( 72)
334 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
335 tagOf_PrimOp FloatSinOp = ILIT( 74)
336 tagOf_PrimOp FloatCosOp = ILIT( 75)
337 tagOf_PrimOp FloatTanOp = ILIT( 76)
338 tagOf_PrimOp FloatAsinOp = ILIT( 77)
339 tagOf_PrimOp FloatAcosOp = ILIT( 78)
340 tagOf_PrimOp FloatAtanOp = ILIT( 79)
341 tagOf_PrimOp FloatSinhOp = ILIT( 80)
342 tagOf_PrimOp FloatCoshOp = ILIT( 81)
343 tagOf_PrimOp FloatTanhOp = ILIT( 82)
344 tagOf_PrimOp FloatPowerOp = ILIT( 83)
345 tagOf_PrimOp DoubleAddOp = ILIT( 84)
346 tagOf_PrimOp DoubleSubOp = ILIT( 85)
347 tagOf_PrimOp DoubleMulOp = ILIT( 86)
348 tagOf_PrimOp DoubleDivOp = ILIT( 87)
349 tagOf_PrimOp DoubleNegOp = ILIT( 88)
350 tagOf_PrimOp Double2IntOp = ILIT( 89)
351 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
352 tagOf_PrimOp Double2FloatOp = ILIT( 91)
353 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
354 tagOf_PrimOp DoubleExpOp = ILIT( 93)
355 tagOf_PrimOp DoubleLogOp = ILIT( 94)
356 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
357 tagOf_PrimOp DoubleSinOp = ILIT( 96)
358 tagOf_PrimOp DoubleCosOp = ILIT( 97)
359 tagOf_PrimOp DoubleTanOp = ILIT( 98)
360 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
361 tagOf_PrimOp DoubleAcosOp = ILIT(100)
362 tagOf_PrimOp DoubleAtanOp = ILIT(101)
363 tagOf_PrimOp DoubleSinhOp = ILIT(102)
364 tagOf_PrimOp DoubleCoshOp = ILIT(103)
365 tagOf_PrimOp DoubleTanhOp = ILIT(104)
366 tagOf_PrimOp DoublePowerOp = ILIT(105)
367 tagOf_PrimOp IntegerAddOp = ILIT(106)
368 tagOf_PrimOp IntegerSubOp = ILIT(107)
369 tagOf_PrimOp IntegerMulOp = ILIT(108)
370 tagOf_PrimOp IntegerQuotRemOp = ILIT(109)
371 tagOf_PrimOp IntegerDivModOp = ILIT(110)
372 tagOf_PrimOp IntegerNegOp = ILIT(111)
373 tagOf_PrimOp IntegerCmpOp = ILIT(112)
374 tagOf_PrimOp Integer2IntOp = ILIT(113)
375 tagOf_PrimOp Integer2WordOp = ILIT(114)
376 tagOf_PrimOp Int2IntegerOp = ILIT(115)
377 tagOf_PrimOp Word2IntegerOp = ILIT(116)
378 tagOf_PrimOp Addr2IntegerOp = ILIT(117)
379 tagOf_PrimOp FloatEncodeOp = ILIT(118)
380 tagOf_PrimOp FloatDecodeOp = ILIT(119)
381 tagOf_PrimOp DoubleEncodeOp = ILIT(120)
382 tagOf_PrimOp DoubleDecodeOp = ILIT(121)
383 tagOf_PrimOp NewArrayOp = ILIT(122)
384 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(123)
385 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(124)
386 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(125)
387 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(126)
388 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(127)
389 tagOf_PrimOp SameMutableArrayOp = ILIT(128)
390 tagOf_PrimOp SameMutableByteArrayOp = ILIT(129)
391 tagOf_PrimOp ReadArrayOp = ILIT(130)
392 tagOf_PrimOp WriteArrayOp = ILIT(131)
393 tagOf_PrimOp IndexArrayOp = ILIT(132)
394 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(133)
395 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(134)
396 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(135)
397 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(136)
398 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(137)
399 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(138)
400 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(139)
401 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(140)
402 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(141)
403 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(142)
404 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(143)
405 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(144)
406 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(145)
407 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(146)
408 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(147)
409 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(148)
410 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(149)
411 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(150)
412 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(151)
413 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(152)
414 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(153)
415 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(154)
416 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(155)
417 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(156)
418 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(157)
419 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(158)
420 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(159)
421 tagOf_PrimOp NewSynchVarOp = ILIT(160)
422 tagOf_PrimOp TakeMVarOp = ILIT(161)
423 tagOf_PrimOp PutMVarOp = ILIT(162)
424 tagOf_PrimOp ReadIVarOp = ILIT(163)
425 tagOf_PrimOp WriteIVarOp = ILIT(164)
426 tagOf_PrimOp MakeForeignObjOp = ILIT(165)
427 tagOf_PrimOp WriteForeignObjOp = ILIT(166)
428 tagOf_PrimOp MakeStablePtrOp = ILIT(167)
429 tagOf_PrimOp DeRefStablePtrOp = ILIT(168)
430 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(169)
431 tagOf_PrimOp ErrorIOPrimOp = ILIT(170)
432 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(171)
433 tagOf_PrimOp SeqOp = ILIT(172)
434 tagOf_PrimOp ParOp = ILIT(173)
435 tagOf_PrimOp ForkOp = ILIT(174)
436 tagOf_PrimOp DelayOp = ILIT(175)
437 tagOf_PrimOp WaitReadOp = ILIT(176)
438 tagOf_PrimOp WaitWriteOp = ILIT(177)
439 tagOf_PrimOp ParGlobalOp = ILIT(178)
440 tagOf_PrimOp ParLocalOp = ILIT(179)
441 tagOf_PrimOp ParAtOp = ILIT(180)
442 tagOf_PrimOp ParAtAbsOp = ILIT(181)
443 tagOf_PrimOp ParAtRelOp = ILIT(182)
444 tagOf_PrimOp ParAtForNowOp = ILIT(183)
445 tagOf_PrimOp CopyableOp = ILIT(184)
446 tagOf_PrimOp NoFollowOp = ILIT(185)
448 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
450 instance Eq PrimOp where
451 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
454 An @Enum@-derived list would be better; meanwhile... (ToDo)
576 NewByteArrayOp CharRep,
577 NewByteArrayOp IntRep,
578 NewByteArrayOp AddrRep,
579 NewByteArrayOp FloatRep,
580 NewByteArrayOp DoubleRep,
582 SameMutableByteArrayOp,
586 ReadByteArrayOp CharRep,
587 ReadByteArrayOp IntRep,
588 ReadByteArrayOp AddrRep,
589 ReadByteArrayOp FloatRep,
590 ReadByteArrayOp DoubleRep,
591 WriteByteArrayOp CharRep,
592 WriteByteArrayOp IntRep,
593 WriteByteArrayOp AddrRep,
594 WriteByteArrayOp FloatRep,
595 WriteByteArrayOp DoubleRep,
596 IndexByteArrayOp CharRep,
597 IndexByteArrayOp IntRep,
598 IndexByteArrayOp AddrRep,
599 IndexByteArrayOp FloatRep,
600 IndexByteArrayOp DoubleRep,
601 IndexOffAddrOp CharRep,
602 IndexOffAddrOp IntRep,
603 IndexOffAddrOp AddrRep,
604 IndexOffAddrOp FloatRep,
605 IndexOffAddrOp DoubleRep,
606 IndexOffForeignObjOp CharRep,
607 IndexOffForeignObjOp IntRep,
608 IndexOffForeignObjOp AddrRep,
609 IndexOffForeignObjOp FloatRep,
610 IndexOffForeignObjOp DoubleRep,
612 UnsafeFreezeByteArrayOp,
623 ReallyUnsafePtrEqualityOp,
642 %************************************************************************
644 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
646 %************************************************************************
648 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
649 refer to the primitive operation. The conventional \tr{#}-for-
650 unboxed ops is added on later.
652 The reason for the funny characters in the names is so we do not
653 interfere with the programmer's Haskell name spaces.
655 We use @PrimKinds@ for the ``type'' information, because they're
656 (slightly) more convenient to use than @TyCons@.
659 = Dyadic FAST_STRING -- string :: T -> T -> T
661 | Monadic FAST_STRING -- string :: T -> T
663 | Compare FAST_STRING -- string :: T -> T -> Bool
665 | Coercing FAST_STRING -- string :: T1 -> T2
669 | PrimResult FAST_STRING
670 [TyVar] [Type] TyCon PrimRep [Type]
671 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
672 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
673 -- D# is a primitive type constructor.
674 -- (the kind is the same info as D#, in another convenient form)
676 | AlgResult FAST_STRING
677 [TyVar] [Type] TyCon [Type]
678 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
679 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
681 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
686 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
688 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
689 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
690 an_Integer_and_Int_tys
691 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
694 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
696 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
698 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
700 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
703 @primOpInfo@ gives all essential information (from which everything
704 else, notably a type, can be constructed) for each @PrimOp@.
707 primOpInfo :: PrimOp -> PrimOpInfo
710 There's plenty of this stuff!
712 %************************************************************************
714 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
716 %************************************************************************
719 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
720 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
721 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
722 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
723 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
724 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
726 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
727 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
728 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
729 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
730 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
731 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
733 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
734 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
735 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
736 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
737 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
738 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
740 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
741 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
742 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
743 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
744 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
745 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
747 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
748 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
749 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
750 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
751 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
752 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
754 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
755 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
756 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
757 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
758 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
759 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
762 %************************************************************************
764 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
766 %************************************************************************
769 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
770 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
773 %************************************************************************
775 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
777 %************************************************************************
780 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
781 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
782 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
783 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
784 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
786 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
787 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
790 %************************************************************************
792 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
794 %************************************************************************
796 A @Word#@ is an unsigned @Int#@.
799 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
800 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
802 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
803 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
804 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
805 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
808 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
810 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
812 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
815 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
817 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
819 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
821 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
822 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
825 %************************************************************************
827 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
829 %************************************************************************
832 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
833 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
836 %************************************************************************
838 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
840 %************************************************************************
842 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
846 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
847 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
848 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
849 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
850 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
852 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
853 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
855 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
856 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
857 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
858 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
859 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
860 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
861 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
862 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
863 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
864 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
865 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
866 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
867 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
870 %************************************************************************
872 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
874 %************************************************************************
876 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
880 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
881 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
882 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
883 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
884 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
886 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
887 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
889 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
890 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
892 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
893 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
894 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
895 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
896 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
897 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
898 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
899 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
900 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
901 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
902 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
903 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
904 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
907 %************************************************************************
909 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
911 %************************************************************************
914 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
916 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
917 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
918 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
920 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
922 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
923 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
925 primOpInfo Integer2IntOp
926 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
928 primOpInfo Integer2WordOp
929 = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
931 primOpInfo Int2IntegerOp
932 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
934 primOpInfo Word2IntegerOp
935 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
937 primOpInfo Addr2IntegerOp
938 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
941 Encoding and decoding of floating-point numbers is sorta
945 primOpInfo FloatEncodeOp
946 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
947 floatPrimTyCon FloatRep []
949 primOpInfo DoubleEncodeOp
950 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
951 doublePrimTyCon DoubleRep []
953 primOpInfo FloatDecodeOp
954 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
956 primOpInfo DoubleDecodeOp
957 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
960 %************************************************************************
962 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
964 %************************************************************************
967 primOpInfo NewArrayOp
969 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
971 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
972 stateAndMutableArrayPrimTyCon [s, elt]
974 primOpInfo (NewByteArrayOp kind)
976 s = alphaTy; s_tv = alphaTyVar
978 (str, _, prim_tycon) = getPrimRepInfo kind
980 op_str = _PK_ ("new" ++ str ++ "Array#")
982 AlgResult op_str [s_tv]
983 [intPrimTy, mkStatePrimTy s]
984 stateAndMutableByteArrayPrimTyCon [s]
986 ---------------------------------------------------------------------------
988 primOpInfo SameMutableArrayOp
990 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
991 mut_arr_ty = mkMutableArrayPrimTy s elt
993 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
996 primOpInfo SameMutableByteArrayOp
998 s = alphaTy; s_tv = alphaTyVar;
999 mut_arr_ty = mkMutableByteArrayPrimTy s
1001 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1004 ---------------------------------------------------------------------------
1005 -- Primitive arrays of Haskell pointers:
1007 primOpInfo ReadArrayOp
1009 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1011 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1012 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1013 stateAndPtrPrimTyCon [s, elt]
1016 primOpInfo WriteArrayOp
1018 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1020 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1021 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1022 statePrimTyCon VoidRep [s]
1024 primOpInfo IndexArrayOp
1025 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1026 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1029 ---------------------------------------------------------------------------
1030 -- Primitive arrays full of unboxed bytes:
1032 primOpInfo (ReadByteArrayOp kind)
1034 s = alphaTy; s_tv = alphaTyVar
1036 (str, _, prim_tycon) = getPrimRepInfo kind
1038 op_str = _PK_ ("read" ++ str ++ "Array#")
1039 relevant_tycon = assoc "primOpInfo" tbl kind
1041 AlgResult op_str [s_tv]
1042 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1045 tbl = [ (CharRep, stateAndCharPrimTyCon),
1046 (IntRep, stateAndIntPrimTyCon),
1047 (AddrRep, stateAndAddrPrimTyCon),
1048 (FloatRep, stateAndFloatPrimTyCon),
1049 (DoubleRep, stateAndDoublePrimTyCon) ]
1051 -- How come there's no Word byte arrays? ADR
1053 primOpInfo (WriteByteArrayOp kind)
1055 s = alphaTy; s_tv = alphaTyVar
1057 (str, prim_ty, _) = getPrimRepInfo kind
1058 op_str = _PK_ ("write" ++ str ++ "Array#")
1060 -- NB: *Prim*Result --
1061 PrimResult op_str [s_tv]
1062 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1063 statePrimTyCon VoidRep [s]
1065 primOpInfo (IndexByteArrayOp kind)
1067 (str, _, prim_tycon) = getPrimRepInfo kind
1068 op_str = _PK_ ("index" ++ str ++ "Array#")
1070 -- NB: *Prim*Result --
1071 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1073 primOpInfo (IndexOffAddrOp kind)
1075 (str, _, prim_tycon) = getPrimRepInfo kind
1076 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1078 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1080 primOpInfo (IndexOffForeignObjOp kind)
1082 (str, _, prim_tycon) = getPrimRepInfo kind
1083 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1085 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1087 ---------------------------------------------------------------------------
1088 primOpInfo UnsafeFreezeArrayOp
1090 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1092 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1093 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1094 stateAndArrayPrimTyCon [s, elt]
1096 primOpInfo UnsafeFreezeByteArrayOp
1097 = let { s = alphaTy; s_tv = alphaTyVar } in
1098 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1099 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1100 stateAndByteArrayPrimTyCon [s]
1103 %************************************************************************
1105 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1107 %************************************************************************
1110 primOpInfo NewSynchVarOp
1112 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1114 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1115 stateAndSynchVarPrimTyCon [s, elt]
1117 primOpInfo TakeMVarOp
1119 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1121 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1122 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1123 stateAndPtrPrimTyCon [s, elt]
1125 primOpInfo PutMVarOp
1127 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1129 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1130 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1133 primOpInfo ReadIVarOp
1135 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1137 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1138 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1139 stateAndPtrPrimTyCon [s, elt]
1141 primOpInfo WriteIVarOp
1143 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1145 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1146 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1151 %************************************************************************
1153 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1155 %************************************************************************
1161 s = alphaTy; s_tv = alphaTyVar
1163 PrimResult SLIT("delay#") [s_tv]
1164 [intPrimTy, mkStatePrimTy s]
1165 statePrimTyCon VoidRep [s]
1167 primOpInfo WaitReadOp
1169 s = alphaTy; s_tv = alphaTyVar
1171 PrimResult SLIT("waitRead#") [s_tv]
1172 [intPrimTy, mkStatePrimTy s]
1173 statePrimTyCon VoidRep [s]
1175 primOpInfo WaitWriteOp
1177 s = alphaTy; s_tv = alphaTyVar
1179 PrimResult SLIT("waitWrite#") [s_tv]
1180 [intPrimTy, mkStatePrimTy s]
1181 statePrimTyCon VoidRep [s]
1184 %************************************************************************
1186 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1188 %************************************************************************
1190 Not everything should/can be in the Haskell heap. As an example, in an
1191 image processing application written in Haskell, you really would like
1192 to avoid heaving huge images between different space or generations of
1193 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1194 which refer to some externally allocated structure/value. Using @ForeignObj@,
1195 just a reference to an image is present in the heap, the image could then
1196 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1197 a completely separate address space alltogether.
1199 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1200 associated with the object is invoked (currently, each ForeignObj has a
1201 direct reference to its finaliser). -- SOF
1203 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1206 makeForeignObj# :: Addr# -- foreign object
1207 -> Addr# -- ptr to its finaliser routine
1208 -> StateAndForeignObj# _RealWorld# ForeignObj#
1213 primOpInfo MakeForeignObjOp
1214 = AlgResult SLIT("makeForeignObj#") []
1215 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1216 stateAndForeignObjPrimTyCon [realWorldTy]
1220 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1221 the external object wrapped up inside a @ForeignObj@. This primitive is used
1222 when a mixed programming interface of implicit and explicit de-allocation is used,
1223 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1224 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1225 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1226 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1227 We deal with this situation, by allowing the programmer to destructively modify
1228 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1229 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1232 writeForeignObj# :: ForeignObj# -- foreign object
1233 -> Addr# -- new data value
1234 -> StateAndForeignObj# _RealWorld# ForeignObj#
1238 primOpInfo WriteForeignObjOp
1240 s = alphaTy; s_tv = alphaTyVar
1242 PrimResult SLIT("writeForeignObj#") [s_tv]
1243 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1244 statePrimTyCon VoidRep [s]
1247 %************************************************************************
1249 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1251 %************************************************************************
1253 A {\em stable pointer} is an index into a table of pointers into the
1254 heap. Since the garbage collector is told about stable pointers, it
1255 is safe to pass a stable pointer to external systems such as C
1258 Here's what the operations and types are supposed to be (from
1259 state-interface document).
1262 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1263 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1264 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1267 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1268 operation since it doesn't (directly) involve IO operations. The
1269 reason is that if some optimisation pass decided to duplicate calls to
1270 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1271 massive space leak can result. Putting it into the PrimIO monad
1272 prevents this. (Another reason for putting them in a monad is to
1273 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1276 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1277 besides, it's not likely to be used from Haskell) so it's not a
1280 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1283 primOpInfo MakeStablePtrOp
1284 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1285 [alphaTy, realWorldStatePrimTy]
1286 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1288 primOpInfo DeRefStablePtrOp
1289 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1290 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1291 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1294 %************************************************************************
1296 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1298 %************************************************************************
1300 [Alastair Reid is to blame for this!]
1302 These days, (Glasgow) Haskell seems to have a bit of everything from
1303 other languages: strict operations, mutable variables, sequencing,
1304 pointers, etc. About the only thing left is LISP's ability to test
1305 for pointer equality. So, let's add it in!
1308 reallyUnsafePtrEquality :: a -> a -> Int#
1311 which tests any two closures (of the same type) to see if they're the
1312 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1313 difficulties of trying to box up the result.)
1315 NB This is {\em really unsafe\/} because even something as trivial as
1316 a garbage collection might change the answer by removing indirections.
1317 Still, no-one's forcing you to use it. If you're worried about little
1318 things like loss of referential transparency, you might like to wrap
1319 it all up in a monad-like thing as John O'Donnell and John Hughes did
1320 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1323 I'm thinking of using it to speed up a critical equality test in some
1324 graphics stuff in a context where the possibility of saying that
1325 denotationally equal things aren't isn't a problem (as long as it
1326 doesn't happen too often.) ADR
1328 To Will: Jim said this was already in, but I can't see it so I'm
1329 adding it. Up to you whether you add it. (Note that this could have
1330 been readily implemented using a @veryDangerousCCall@ before they were
1334 primOpInfo ReallyUnsafePtrEqualityOp
1335 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1336 [alphaTy, alphaTy] intPrimTyCon IntRep []
1339 %************************************************************************
1341 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1343 %************************************************************************
1346 primOpInfo SeqOp -- seq# :: a -> Int#
1347 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1349 primOpInfo ParOp -- par# :: a -> Int#
1350 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1352 primOpInfo ForkOp -- fork# :: a -> Int#
1353 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1358 -- HWL: The first 4 Int# in all par... annotations denote:
1359 -- name, granularity info, size of result, degree of parallelism
1360 -- Same structure as _seq_ i.e. returns Int#
1362 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1363 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1365 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1366 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1368 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1369 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1371 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1372 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1374 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1375 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1377 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1378 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1380 primOpInfo CopyableOp -- copyable# :: a -> a
1381 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1383 primOpInfo NoFollowOp -- noFollow# :: a -> a
1384 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1387 %************************************************************************
1389 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1391 %************************************************************************
1394 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1395 primOpInfo ErrorIOPrimOp
1396 = PrimResult SLIT("errorIO#") [alphaTyVar]
1397 [mkFunTy realWorldStatePrimTy alphaTy]
1398 statePrimTyCon VoidRep [realWorldTy]
1401 %************************************************************************
1403 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1405 %************************************************************************
1408 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1409 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1411 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1414 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1418 %************************************************************************
1420 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1422 %************************************************************************
1424 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1425 with @Integers@ can trigger GC. Here we describe the heap requirements
1426 of the various @PrimOps@. For most, no heap is required. For a few,
1427 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1428 be combined with the rest of the heap usage in the basic block. For an
1429 unfortunate few, some unknown amount of heap is required (these are the
1430 ops which can trigger GC).
1433 data HeapRequirement
1435 | FixedHeapRequired HeapOffset
1436 | VariableHeapRequired
1438 primOpHeapReq :: PrimOp -> HeapRequirement
1440 primOpHeapReq NewArrayOp = VariableHeapRequired
1441 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1443 primOpHeapReq IntegerAddOp = VariableHeapRequired
1444 primOpHeapReq IntegerSubOp = VariableHeapRequired
1445 primOpHeapReq IntegerMulOp = VariableHeapRequired
1446 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1447 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1448 primOpHeapReq IntegerNegOp = VariableHeapRequired
1449 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1450 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1451 (intOff mIN_MP_INT_SIZE))
1452 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1453 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1454 (intOff mIN_MP_INT_SIZE))
1455 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1456 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1457 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1458 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1459 (intOff mIN_MP_INT_SIZE)))
1460 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1461 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1462 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1463 (intOff mIN_MP_INT_SIZE)))
1466 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1467 or if it returns a ForeignObj.
1469 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1470 why do we need to be so indeterminate about it? --SOF
1472 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1473 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1475 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1476 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1478 -- this occasionally has to expand the Stable Pointer table
1479 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1481 -- These four only need heap space with the native code generator
1482 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1484 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1485 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1486 primOpHeapReq Integer2WordOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1487 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1488 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1490 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1491 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1492 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1494 -- Sparking ops no longer allocate any heap; however, _fork_ may
1495 -- require a context switch to clear space in the required thread
1496 -- pool, and that requires liveness information.
1498 primOpHeapReq ParOp = NoHeapRequired
1499 primOpHeapReq ForkOp = VariableHeapRequired
1501 -- A SeqOp requires unknown space to evaluate its argument
1502 primOpHeapReq SeqOp = VariableHeapRequired
1504 -- GranSim sparks are stgMalloced i.e. no heap required
1505 primOpHeapReq ParGlobalOp = NoHeapRequired
1506 primOpHeapReq ParLocalOp = NoHeapRequired
1507 primOpHeapReq ParAtOp = NoHeapRequired
1508 primOpHeapReq ParAtAbsOp = NoHeapRequired
1509 primOpHeapReq ParAtRelOp = NoHeapRequired
1510 primOpHeapReq ParAtForNowOp = NoHeapRequired
1511 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1512 primOpHeapReq CopyableOp = NoHeapRequired
1513 primOpHeapReq NoFollowOp = NoHeapRequired
1515 primOpHeapReq other_op = NoHeapRequired
1518 The amount of stack required by primops.
1521 data StackRequirement
1523 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1524 | VariableStackRequired
1526 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1527 primOpStackRequired _ = VariableStackRequired
1528 -- ToDo: be more specific for certain primops (currently only used for seq)
1531 Primops which can trigger GC have to be called carefully.
1532 In particular, their arguments are guaranteed to be in registers,
1533 and a liveness mask tells which regs are live.
1536 primOpCanTriggerGC op
1544 case primOpHeapReq op of
1545 VariableHeapRequired -> True
1549 Sometimes we may choose to execute a PrimOp even though it isn't
1550 certain that its result will be required; ie execute them
1551 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1552 this is OK, because PrimOps are usually cheap, but it isn't OK for
1553 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1555 See also @primOpIsCheap@ (below).
1557 There should be no worries about side effects; that's all taken care
1558 of by data dependencies.
1561 primOpOkForSpeculation :: PrimOp -> Bool
1564 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1565 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1568 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1569 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1571 -- Float. ToDo: tan? tanh?
1572 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1573 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1574 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1575 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1577 -- Double. ToDo: tan? tanh?
1578 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1579 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1580 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1581 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1584 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1587 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1590 primOpOkForSpeculation ParOp = False -- Could be expensive!
1591 primOpOkForSpeculation ForkOp = False -- Likewise
1592 primOpOkForSpeculation SeqOp = False -- Likewise
1594 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1595 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1596 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1597 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1598 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1599 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1600 primOpOkForSpeculation CopyableOp = False -- only tags closure
1601 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1603 -- The default is "yes it's ok for speculation"
1604 primOpOkForSpeculation other_op = True
1607 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1608 WARNING), we just borrow some other predicates for a
1609 what-should-be-good-enough test.
1612 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1615 And some primops have side-effects and so, for example, must not be
1619 fragilePrimOp :: PrimOp -> Bool
1621 fragilePrimOp ParOp = True
1622 fragilePrimOp ForkOp = True
1623 fragilePrimOp SeqOp = True
1624 fragilePrimOp MakeForeignObjOp = True -- SOF
1625 fragilePrimOp WriteForeignObjOp = True -- SOF
1626 fragilePrimOp MakeStablePtrOp = True
1627 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1629 fragilePrimOp ParGlobalOp = True
1630 fragilePrimOp ParLocalOp = True
1631 fragilePrimOp ParAtOp = True
1632 fragilePrimOp ParAtAbsOp = True
1633 fragilePrimOp ParAtRelOp = True
1634 fragilePrimOp ParAtForNowOp = True
1635 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1636 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1638 fragilePrimOp other = False
1641 Primitive operations that perform calls need wrappers to save any live variables
1642 that are stored in caller-saves registers
1645 primOpNeedsWrapper :: PrimOp -> Bool
1647 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1649 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1650 primOpNeedsWrapper (NewByteArrayOp _) = True
1652 primOpNeedsWrapper IntegerAddOp = True
1653 primOpNeedsWrapper IntegerSubOp = True
1654 primOpNeedsWrapper IntegerMulOp = True
1655 primOpNeedsWrapper IntegerQuotRemOp = True
1656 primOpNeedsWrapper IntegerDivModOp = True
1657 primOpNeedsWrapper IntegerNegOp = True
1658 primOpNeedsWrapper IntegerCmpOp = True
1659 primOpNeedsWrapper Integer2IntOp = True
1660 primOpNeedsWrapper Integer2WordOp = True
1661 primOpNeedsWrapper Int2IntegerOp = True
1662 primOpNeedsWrapper Word2IntegerOp = True
1663 primOpNeedsWrapper Addr2IntegerOp = True
1665 primOpNeedsWrapper FloatExpOp = True
1666 primOpNeedsWrapper FloatLogOp = True
1667 primOpNeedsWrapper FloatSqrtOp = True
1668 primOpNeedsWrapper FloatSinOp = True
1669 primOpNeedsWrapper FloatCosOp = True
1670 primOpNeedsWrapper FloatTanOp = True
1671 primOpNeedsWrapper FloatAsinOp = True
1672 primOpNeedsWrapper FloatAcosOp = True
1673 primOpNeedsWrapper FloatAtanOp = True
1674 primOpNeedsWrapper FloatSinhOp = True
1675 primOpNeedsWrapper FloatCoshOp = True
1676 primOpNeedsWrapper FloatTanhOp = True
1677 primOpNeedsWrapper FloatPowerOp = True
1678 primOpNeedsWrapper FloatEncodeOp = True
1679 primOpNeedsWrapper FloatDecodeOp = True
1681 primOpNeedsWrapper DoubleExpOp = True
1682 primOpNeedsWrapper DoubleLogOp = True
1683 primOpNeedsWrapper DoubleSqrtOp = True
1684 primOpNeedsWrapper DoubleSinOp = True
1685 primOpNeedsWrapper DoubleCosOp = True
1686 primOpNeedsWrapper DoubleTanOp = True
1687 primOpNeedsWrapper DoubleAsinOp = True
1688 primOpNeedsWrapper DoubleAcosOp = True
1689 primOpNeedsWrapper DoubleAtanOp = True
1690 primOpNeedsWrapper DoubleSinhOp = True
1691 primOpNeedsWrapper DoubleCoshOp = True
1692 primOpNeedsWrapper DoubleTanhOp = True
1693 primOpNeedsWrapper DoublePowerOp = True
1694 primOpNeedsWrapper DoubleEncodeOp = True
1695 primOpNeedsWrapper DoubleDecodeOp = True
1697 primOpNeedsWrapper MakeForeignObjOp = True
1698 primOpNeedsWrapper WriteForeignObjOp = True
1699 primOpNeedsWrapper MakeStablePtrOp = True
1700 primOpNeedsWrapper DeRefStablePtrOp = True
1702 primOpNeedsWrapper TakeMVarOp = True
1703 primOpNeedsWrapper PutMVarOp = True
1704 primOpNeedsWrapper ReadIVarOp = True
1706 primOpNeedsWrapper DelayOp = True
1707 primOpNeedsWrapper WaitReadOp = True
1708 primOpNeedsWrapper WaitWriteOp = True
1710 primOpNeedsWrapper other_op = False
1715 = case (primOpInfo op) of
1717 Monadic str _ -> str
1718 Compare str _ -> str
1719 Coercing str _ _ -> str
1720 PrimResult str _ _ _ _ _ -> str
1721 AlgResult str _ _ _ _ -> str
1724 @primOpType@ duplicates some work of @primOpId@, but since we
1725 grab types pretty often...
1727 primOpType :: PrimOp -> Type
1730 = case (primOpInfo op) of
1731 Dyadic str ty -> dyadic_fun_ty ty
1732 Monadic str ty -> monadic_fun_ty ty
1733 Compare str ty -> compare_fun_ty ty
1734 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1736 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1737 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1739 AlgResult str tyvars arg_tys tycon res_tys ->
1740 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1744 data PrimOpResultInfo
1745 = ReturnsPrim PrimRep
1748 -- ToDo: Deal with specialised PrimOps
1749 -- Will need to return specialised tycon and data constructors
1751 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1753 getPrimOpResultInfo op
1754 = case (primOpInfo op) of
1755 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1756 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1757 Compare _ ty -> ReturnsAlg boolTyCon
1758 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1759 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1760 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1762 isCompareOp :: PrimOp -> Bool
1765 = case primOpInfo op of
1770 The commutable ops are those for which we will try to move constants
1771 to the right hand side for strength reduction.
1774 commutableOp :: PrimOp -> Bool
1776 commutableOp CharEqOp = True
1777 commutableOp CharNeOp = True
1778 commutableOp IntAddOp = True
1779 commutableOp IntMulOp = True
1780 commutableOp AndOp = True
1781 commutableOp OrOp = True
1782 commutableOp XorOp = True
1783 commutableOp IntEqOp = True
1784 commutableOp IntNeOp = True
1785 commutableOp IntegerAddOp = True
1786 commutableOp IntegerMulOp = True
1787 commutableOp FloatAddOp = True
1788 commutableOp FloatMulOp = True
1789 commutableOp FloatEqOp = True
1790 commutableOp FloatNeOp = True
1791 commutableOp DoubleAddOp = True
1792 commutableOp DoubleMulOp = True
1793 commutableOp DoubleEqOp = True
1794 commutableOp DoubleNeOp = True
1795 commutableOp _ = False
1800 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1801 monadic_fun_ty ty = mkFunTy ty ty
1802 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1807 pprPrimOp :: PrimOp -> SDoc
1808 showPrimOp :: PrimOp -> String
1810 showPrimOp op = showSDoc (pprPrimOp op)
1812 pprPrimOp (CCallOp fun is_casm may_gc arg_tys res_ty)
1816 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1818 if may_gc then "_ccall_GC_ " else "_ccall_ "
1821 = if is_casm then text "''" else empty
1824 = hsep (map pprParendGenType (res_ty:arg_tys))
1826 hcat [text before, ptext fun, after, space, brackets pp_tys]
1829 = getPprStyle $ \ sty ->
1830 if codeStyle sty then -- For C just print the primop itself
1832 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1833 ptext SLIT("PrelGHC.") <> ptext str
1834 else -- Unqualified is good enough
1837 str = primOp_str other_op
1840 instance Outputable PrimOp where
1841 ppr op = pprPrimOp op