2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrimOp]{Primitive operations (machine-level)}
7 #include "HsVersions.h"
10 PrimOp(..), allThePrimOps,
11 tagOf_PrimOp, -- ToDo: rm
13 primOpType, isCompareOp,
19 primOpCanTriggerGC, primOpNeedsWrapper,
20 primOpOkForSpeculation, primOpIsCheap,
22 HeapRequirement(..), primOpHeapReq,
23 StackRequirement(..), primOpStackRequired,
25 -- export for the Native Code Generator
26 primOpInfo, -- needed for primOpNameInfo
34 import PrimRep -- most of it
38 import CStrings ( identToC )
39 import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
40 import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
41 import Outputable ( PprStyle, Outputable(..), codeStyle, ifaceStyle )
42 import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
44 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
45 import TyCon ( TyCon{-instances-} )
46 import Type ( mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep,
47 getAppDataTyConExpandingDicts, SYN_IE(Type)
49 import TyVar --( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
50 import Unique ( Unique{-instance Eq-} )
51 import Util ( panic#, assoc, panic{-ToDo:rm-} )
54 %************************************************************************
56 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
58 %************************************************************************
60 These are in \tr{state-interface.verb} order.
64 -- dig the FORTRAN/C influence on the names...
68 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
69 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
70 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
71 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
72 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
73 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
79 -- IntAbsOp unused?? ADR
80 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
81 | IntRemOp | IntNegOp | IntAbsOp
84 | AndOp | OrOp | NotOp | XorOp
85 | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
86 | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
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 | Int2IntegerOp
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( 46)
309 tagOf_PrimOp AndOp = ILIT( 47)
310 tagOf_PrimOp OrOp = ILIT( 48)
311 tagOf_PrimOp NotOp = ILIT( 49)
312 tagOf_PrimOp XorOp = ILIT( 50)
313 tagOf_PrimOp SllOp = ILIT( 51)
314 tagOf_PrimOp SraOp = ILIT( 52)
315 tagOf_PrimOp SrlOp = ILIT( 53)
316 tagOf_PrimOp ISllOp = ILIT( 54)
317 tagOf_PrimOp ISraOp = ILIT( 55)
318 tagOf_PrimOp ISrlOp = ILIT( 56)
319 tagOf_PrimOp Int2WordOp = ILIT( 57)
320 tagOf_PrimOp Word2IntOp = ILIT( 58)
321 tagOf_PrimOp Int2AddrOp = ILIT( 59)
322 tagOf_PrimOp Addr2IntOp = ILIT( 60)
323 tagOf_PrimOp FloatAddOp = ILIT( 61)
324 tagOf_PrimOp FloatSubOp = ILIT( 62)
325 tagOf_PrimOp FloatMulOp = ILIT( 63)
326 tagOf_PrimOp FloatDivOp = ILIT( 64)
327 tagOf_PrimOp FloatNegOp = ILIT( 65)
328 tagOf_PrimOp Float2IntOp = ILIT( 66)
329 tagOf_PrimOp Int2FloatOp = ILIT( 67)
330 tagOf_PrimOp FloatExpOp = ILIT( 68)
331 tagOf_PrimOp FloatLogOp = ILIT( 69)
332 tagOf_PrimOp FloatSqrtOp = ILIT( 70)
333 tagOf_PrimOp FloatSinOp = ILIT( 71)
334 tagOf_PrimOp FloatCosOp = ILIT( 72)
335 tagOf_PrimOp FloatTanOp = ILIT( 73)
336 tagOf_PrimOp FloatAsinOp = ILIT( 74)
337 tagOf_PrimOp FloatAcosOp = ILIT( 75)
338 tagOf_PrimOp FloatAtanOp = ILIT( 76)
339 tagOf_PrimOp FloatSinhOp = ILIT( 77)
340 tagOf_PrimOp FloatCoshOp = ILIT( 78)
341 tagOf_PrimOp FloatTanhOp = ILIT( 79)
342 tagOf_PrimOp FloatPowerOp = ILIT( 80)
343 tagOf_PrimOp DoubleAddOp = ILIT( 81)
344 tagOf_PrimOp DoubleSubOp = ILIT( 82)
345 tagOf_PrimOp DoubleMulOp = ILIT( 83)
346 tagOf_PrimOp DoubleDivOp = ILIT( 84)
347 tagOf_PrimOp DoubleNegOp = ILIT( 85)
348 tagOf_PrimOp Double2IntOp = ILIT( 86)
349 tagOf_PrimOp Int2DoubleOp = ILIT( 87)
350 tagOf_PrimOp Double2FloatOp = ILIT( 88)
351 tagOf_PrimOp Float2DoubleOp = ILIT( 89)
352 tagOf_PrimOp DoubleExpOp = ILIT( 90)
353 tagOf_PrimOp DoubleLogOp = ILIT( 91)
354 tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
355 tagOf_PrimOp DoubleSinOp = ILIT( 93)
356 tagOf_PrimOp DoubleCosOp = ILIT( 94)
357 tagOf_PrimOp DoubleTanOp = ILIT( 95)
358 tagOf_PrimOp DoubleAsinOp = ILIT( 96)
359 tagOf_PrimOp DoubleAcosOp = ILIT( 97)
360 tagOf_PrimOp DoubleAtanOp = ILIT( 98)
361 tagOf_PrimOp DoubleSinhOp = ILIT( 99)
362 tagOf_PrimOp DoubleCoshOp = ILIT(100)
363 tagOf_PrimOp DoubleTanhOp = ILIT(101)
364 tagOf_PrimOp DoublePowerOp = ILIT(102)
365 tagOf_PrimOp IntegerAddOp = ILIT(103)
366 tagOf_PrimOp IntegerSubOp = ILIT(104)
367 tagOf_PrimOp IntegerMulOp = ILIT(105)
368 tagOf_PrimOp IntegerQuotRemOp = ILIT(106)
369 tagOf_PrimOp IntegerDivModOp = ILIT(107)
370 tagOf_PrimOp IntegerNegOp = ILIT(108)
371 tagOf_PrimOp IntegerCmpOp = ILIT(109)
372 tagOf_PrimOp Integer2IntOp = ILIT(110)
373 tagOf_PrimOp Int2IntegerOp = ILIT(111)
374 tagOf_PrimOp Word2IntegerOp = ILIT(112)
375 tagOf_PrimOp Addr2IntegerOp = ILIT(113)
376 tagOf_PrimOp FloatEncodeOp = ILIT(114)
377 tagOf_PrimOp FloatDecodeOp = ILIT(115)
378 tagOf_PrimOp DoubleEncodeOp = ILIT(116)
379 tagOf_PrimOp DoubleDecodeOp = ILIT(117)
380 tagOf_PrimOp NewArrayOp = ILIT(118)
381 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(119)
382 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(120)
383 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(121)
384 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(122)
385 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(123)
386 tagOf_PrimOp SameMutableArrayOp = ILIT(124)
387 tagOf_PrimOp SameMutableByteArrayOp = ILIT(125)
388 tagOf_PrimOp ReadArrayOp = ILIT(126)
389 tagOf_PrimOp WriteArrayOp = ILIT(127)
390 tagOf_PrimOp IndexArrayOp = ILIT(128)
391 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(129)
392 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(130)
393 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(131)
394 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(132)
395 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(133)
396 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(134)
397 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(135)
398 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(136)
399 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(137)
400 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(138)
401 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(139)
402 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(140)
403 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(141)
404 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(142)
405 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(143)
406 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(144)
407 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(145)
408 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(146)
409 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(147)
410 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(148)
411 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(149)
412 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(150)
413 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(151)
414 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(152)
415 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(153)
416 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(154)
417 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(155)
418 tagOf_PrimOp NewSynchVarOp = ILIT(156)
419 tagOf_PrimOp TakeMVarOp = ILIT(157)
420 tagOf_PrimOp PutMVarOp = ILIT(158)
421 tagOf_PrimOp ReadIVarOp = ILIT(159)
422 tagOf_PrimOp WriteIVarOp = ILIT(160)
423 tagOf_PrimOp MakeForeignObjOp = ILIT(161)
424 tagOf_PrimOp WriteForeignObjOp = ILIT(162)
425 tagOf_PrimOp MakeStablePtrOp = ILIT(163)
426 tagOf_PrimOp DeRefStablePtrOp = ILIT(164)
427 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(165)
428 tagOf_PrimOp ErrorIOPrimOp = ILIT(166)
429 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(167)
430 tagOf_PrimOp SeqOp = ILIT(168)
431 tagOf_PrimOp ParOp = ILIT(169)
432 tagOf_PrimOp ForkOp = ILIT(170)
433 tagOf_PrimOp DelayOp = ILIT(171)
434 tagOf_PrimOp WaitReadOp = ILIT(172)
435 tagOf_PrimOp WaitWriteOp = ILIT(173)
437 tagOf_PrimOp ParGlobalOp = ILIT(174)
438 tagOf_PrimOp ParLocalOp = ILIT(175)
439 tagOf_PrimOp ParAtOp = ILIT(176)
440 tagOf_PrimOp ParAtAbsOp = ILIT(177)
441 tagOf_PrimOp ParAtRelOp = ILIT(178)
442 tagOf_PrimOp ParAtForNowOp = ILIT(179)
443 tagOf_PrimOp CopyableOp = ILIT(180)
444 tagOf_PrimOp NoFollowOp = ILIT(181)
446 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
448 instance Eq PrimOp where
449 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
452 An @Enum@-derived list would be better; meanwhile... (ToDo)
571 NewByteArrayOp CharRep,
572 NewByteArrayOp IntRep,
573 NewByteArrayOp AddrRep,
574 NewByteArrayOp FloatRep,
575 NewByteArrayOp DoubleRep,
577 SameMutableByteArrayOp,
581 ReadByteArrayOp CharRep,
582 ReadByteArrayOp IntRep,
583 ReadByteArrayOp AddrRep,
584 ReadByteArrayOp FloatRep,
585 ReadByteArrayOp DoubleRep,
586 WriteByteArrayOp CharRep,
587 WriteByteArrayOp IntRep,
588 WriteByteArrayOp AddrRep,
589 WriteByteArrayOp FloatRep,
590 WriteByteArrayOp DoubleRep,
591 IndexByteArrayOp CharRep,
592 IndexByteArrayOp IntRep,
593 IndexByteArrayOp AddrRep,
594 IndexByteArrayOp FloatRep,
595 IndexByteArrayOp DoubleRep,
596 IndexOffAddrOp CharRep,
597 IndexOffAddrOp IntRep,
598 IndexOffAddrOp AddrRep,
599 IndexOffAddrOp FloatRep,
600 IndexOffAddrOp DoubleRep,
601 IndexOffForeignObjOp CharRep,
602 IndexOffForeignObjOp IntRep,
603 IndexOffForeignObjOp AddrRep,
604 IndexOffForeignObjOp FloatRep,
605 IndexOffForeignObjOp DoubleRep,
607 UnsafeFreezeByteArrayOp,
618 ReallyUnsafePtrEqualityOp,
637 %************************************************************************
639 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
641 %************************************************************************
643 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
644 refer to the primitive operation. The conventional \tr{#}-for-
645 unboxed ops is added on later.
647 The reason for the funny characters in the names is so we do not
648 interfere with the programmer's Haskell name spaces.
650 We use @PrimKinds@ for the ``type'' information, because they're
651 (slightly) more convenient to use than @TyCons@.
654 = Dyadic FAST_STRING -- string :: T -> T -> T
656 | Monadic FAST_STRING -- string :: T -> T
658 | Compare FAST_STRING -- string :: T -> T -> Bool
660 | Coercing FAST_STRING -- string :: T1 -> T2
664 | PrimResult FAST_STRING
665 [TyVar] [Type] TyCon PrimRep [Type]
666 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
667 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
668 -- D# is a primitive type constructor.
669 -- (the kind is the same info as D#, in another convenient form)
671 | AlgResult FAST_STRING
672 [TyVar] [Type] TyCon [Type]
673 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
674 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
676 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
681 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
683 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
684 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
685 an_Integer_and_Int_tys
686 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
689 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
691 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
693 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
695 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
698 @primOpInfo@ gives all essential information (from which everything
699 else, notably a type, can be constructed) for each @PrimOp@.
702 primOpInfo :: PrimOp -> PrimOpInfo
705 There's plenty of this stuff!
707 %************************************************************************
709 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
711 %************************************************************************
714 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
715 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
716 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
717 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
718 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
719 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
721 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
722 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
723 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
724 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
725 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
726 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
728 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
729 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
730 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
731 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
732 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
733 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
735 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
736 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
737 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
738 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
739 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
740 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
742 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
743 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
744 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
745 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
746 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
747 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
749 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
750 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
751 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
752 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
753 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
754 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
757 %************************************************************************
759 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
761 %************************************************************************
764 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
765 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
768 %************************************************************************
770 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
772 %************************************************************************
775 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
776 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
777 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
778 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
779 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
781 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
782 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
785 %************************************************************************
787 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
789 %************************************************************************
791 A @Word#@ is an unsigned @Int#@.
794 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
795 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
796 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
797 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
800 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
802 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
804 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
807 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
809 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
811 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
813 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
814 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
817 %************************************************************************
819 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
821 %************************************************************************
824 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
825 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
828 %************************************************************************
830 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
832 %************************************************************************
834 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
838 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
839 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
840 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
841 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
842 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
844 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
845 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
847 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
848 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
849 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
850 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
851 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
852 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
853 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
854 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
855 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
856 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
857 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
858 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
859 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
862 %************************************************************************
864 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
866 %************************************************************************
868 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
872 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
873 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
874 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
875 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
876 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
878 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
879 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
881 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
882 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
884 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
885 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
886 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
887 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
888 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
889 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
890 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
891 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
892 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
893 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
894 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
895 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
896 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
899 %************************************************************************
901 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
903 %************************************************************************
906 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
908 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
909 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
910 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
912 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
914 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
915 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
917 primOpInfo Integer2IntOp
918 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
920 primOpInfo Int2IntegerOp
921 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
923 primOpInfo Word2IntegerOp
924 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
926 primOpInfo Addr2IntegerOp
927 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
930 Encoding and decoding of floating-point numbers is sorta
934 primOpInfo FloatEncodeOp
935 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
936 floatPrimTyCon FloatRep []
938 primOpInfo DoubleEncodeOp
939 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
940 doublePrimTyCon DoubleRep []
942 primOpInfo FloatDecodeOp
943 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
945 primOpInfo DoubleDecodeOp
946 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
949 %************************************************************************
951 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
953 %************************************************************************
956 primOpInfo NewArrayOp
958 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
960 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
961 stateAndMutableArrayPrimTyCon [s, elt]
963 primOpInfo (NewByteArrayOp kind)
965 s = alphaTy; s_tv = alphaTyVar
967 (str, _, prim_tycon) = getPrimRepInfo kind
969 op_str = _PK_ ("new" ++ str ++ "Array#")
971 AlgResult op_str [s_tv]
972 [intPrimTy, mkStatePrimTy s]
973 stateAndMutableByteArrayPrimTyCon [s]
975 ---------------------------------------------------------------------------
977 primOpInfo SameMutableArrayOp
979 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
980 mut_arr_ty = mkMutableArrayPrimTy s elt
982 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
985 primOpInfo SameMutableByteArrayOp
987 s = alphaTy; s_tv = alphaTyVar;
988 mut_arr_ty = mkMutableByteArrayPrimTy s
990 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
993 ---------------------------------------------------------------------------
994 -- Primitive arrays of Haskell pointers:
996 primOpInfo ReadArrayOp
998 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1000 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1001 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1002 stateAndPtrPrimTyCon [s, elt]
1005 primOpInfo WriteArrayOp
1007 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1009 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1010 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1011 statePrimTyCon VoidRep [s]
1013 primOpInfo IndexArrayOp
1014 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1015 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1018 ---------------------------------------------------------------------------
1019 -- Primitive arrays full of unboxed bytes:
1021 primOpInfo (ReadByteArrayOp kind)
1023 s = alphaTy; s_tv = alphaTyVar
1025 (str, _, prim_tycon) = getPrimRepInfo kind
1027 op_str = _PK_ ("read" ++ str ++ "Array#")
1028 relevant_tycon = assoc "primOpInfo" tbl kind
1030 AlgResult op_str [s_tv]
1031 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1034 tbl = [ (CharRep, stateAndCharPrimTyCon),
1035 (IntRep, stateAndIntPrimTyCon),
1036 (AddrRep, stateAndAddrPrimTyCon),
1037 (FloatRep, stateAndFloatPrimTyCon),
1038 (DoubleRep, stateAndDoublePrimTyCon) ]
1040 -- How come there's no Word byte arrays? ADR
1042 primOpInfo (WriteByteArrayOp kind)
1044 s = alphaTy; s_tv = alphaTyVar
1046 (str, prim_ty, _) = getPrimRepInfo kind
1047 op_str = _PK_ ("write" ++ str ++ "Array#")
1049 -- NB: *Prim*Result --
1050 PrimResult op_str [s_tv]
1051 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1052 statePrimTyCon VoidRep [s]
1054 primOpInfo (IndexByteArrayOp kind)
1056 (str, _, prim_tycon) = getPrimRepInfo kind
1057 op_str = _PK_ ("index" ++ str ++ "Array#")
1059 -- NB: *Prim*Result --
1060 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1062 primOpInfo (IndexOffAddrOp kind)
1064 (str, _, prim_tycon) = getPrimRepInfo kind
1065 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1067 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1069 primOpInfo (IndexOffForeignObjOp kind)
1071 (str, _, prim_tycon) = getPrimRepInfo kind
1072 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1074 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1076 ---------------------------------------------------------------------------
1077 primOpInfo UnsafeFreezeArrayOp
1079 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1081 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1082 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1083 stateAndArrayPrimTyCon [s, elt]
1085 primOpInfo UnsafeFreezeByteArrayOp
1086 = let { s = alphaTy; s_tv = alphaTyVar } in
1087 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1088 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1089 stateAndByteArrayPrimTyCon [s]
1092 %************************************************************************
1094 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1096 %************************************************************************
1099 primOpInfo NewSynchVarOp
1101 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1103 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1104 stateAndSynchVarPrimTyCon [s, elt]
1106 primOpInfo TakeMVarOp
1108 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1110 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1111 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1112 stateAndPtrPrimTyCon [s, elt]
1114 primOpInfo PutMVarOp
1116 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1118 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1119 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1122 primOpInfo ReadIVarOp
1124 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1126 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1127 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1128 stateAndPtrPrimTyCon [s, elt]
1130 primOpInfo WriteIVarOp
1132 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1134 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1135 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1140 %************************************************************************
1142 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1144 %************************************************************************
1150 s = alphaTy; s_tv = alphaTyVar
1152 PrimResult SLIT("delay#") [s_tv]
1153 [intPrimTy, mkStatePrimTy s]
1154 statePrimTyCon VoidRep [s]
1156 primOpInfo WaitReadOp
1158 s = alphaTy; s_tv = alphaTyVar
1160 PrimResult SLIT("waitRead#") [s_tv]
1161 [intPrimTy, mkStatePrimTy s]
1162 statePrimTyCon VoidRep [s]
1164 primOpInfo WaitWriteOp
1166 s = alphaTy; s_tv = alphaTyVar
1168 PrimResult SLIT("waitWrite#") [s_tv]
1169 [intPrimTy, mkStatePrimTy s]
1170 statePrimTyCon VoidRep [s]
1173 %************************************************************************
1175 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1177 %************************************************************************
1179 Not everything should/can be in the Haskell heap. As an example, in an
1180 image processing application written in Haskell, you really would like
1181 to avoid heaving huge images between different space or generations of
1182 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1183 which refer to some externally allocated structure/value. Using @ForeignObj@,
1184 just a reference to an image is present in the heap, the image could then
1185 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1186 a completely separate address space alltogether.
1188 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1189 associated with the object is invoked (currently, each ForeignObj has a
1190 direct reference to its finaliser). -- SOF
1192 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1195 makeForeignObj# :: Addr# -- foreign object
1196 -> Addr# -- ptr to its finaliser routine
1197 -> StateAndForeignObj# _RealWorld# ForeignObj#
1202 primOpInfo MakeForeignObjOp
1203 = AlgResult SLIT("makeForeignObj#") []
1204 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1205 stateAndForeignObjPrimTyCon [realWorldTy]
1209 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1210 the external object wrapped up inside a @ForeignObj@. This primitive is used
1211 when a mixed programming interface of implicit and explicit de-allocation is used,
1212 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1213 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1214 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1215 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1216 We deal with this situation, by allowing the programmer to destructively modify
1217 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1218 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1221 writeForeignObj# :: ForeignObj# -- foreign object
1222 -> Addr# -- new data value
1223 -> StateAndForeignObj# _RealWorld# ForeignObj#
1227 primOpInfo WriteForeignObjOp
1229 s = alphaTy; s_tv = alphaTyVar
1231 PrimResult SLIT("writeForeignObj#") [s_tv]
1232 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1233 statePrimTyCon VoidRep [s]
1236 %************************************************************************
1238 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1240 %************************************************************************
1242 A {\em stable pointer} is an index into a table of pointers into the
1243 heap. Since the garbage collector is told about stable pointers, it
1244 is safe to pass a stable pointer to external systems such as C
1247 Here's what the operations and types are supposed to be (from
1248 state-interface document).
1251 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1252 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1253 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1256 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1257 operation since it doesn't (directly) involve IO operations. The
1258 reason is that if some optimisation pass decided to duplicate calls to
1259 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1260 massive space leak can result. Putting it into the PrimIO monad
1261 prevents this. (Another reason for putting them in a monad is to
1262 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1265 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1266 besides, it's not likely to be used from Haskell) so it's not a
1269 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1272 primOpInfo MakeStablePtrOp
1273 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1274 [alphaTy, realWorldStatePrimTy]
1275 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1277 primOpInfo DeRefStablePtrOp
1278 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1279 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1280 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1283 %************************************************************************
1285 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1287 %************************************************************************
1289 [Alastair Reid is to blame for this!]
1291 These days, (Glasgow) Haskell seems to have a bit of everything from
1292 other languages: strict operations, mutable variables, sequencing,
1293 pointers, etc. About the only thing left is LISP's ability to test
1294 for pointer equality. So, let's add it in!
1297 reallyUnsafePtrEquality :: a -> a -> Int#
1300 which tests any two closures (of the same type) to see if they're the
1301 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1302 difficulties of trying to box up the result.)
1304 NB This is {\em really unsafe\/} because even something as trivial as
1305 a garbage collection might change the answer by removing indirections.
1306 Still, no-one's forcing you to use it. If you're worried about little
1307 things like loss of referential transparency, you might like to wrap
1308 it all up in a monad-like thing as John O'Donnell and John Hughes did
1309 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1312 I'm thinking of using it to speed up a critical equality test in some
1313 graphics stuff in a context where the possibility of saying that
1314 denotationally equal things aren't isn't a problem (as long as it
1315 doesn't happen too often.) ADR
1317 To Will: Jim said this was already in, but I can't see it so I'm
1318 adding it. Up to you whether you add it. (Note that this could have
1319 been readily implemented using a @veryDangerousCCall@ before they were
1323 primOpInfo ReallyUnsafePtrEqualityOp
1324 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1325 [alphaTy, alphaTy] intPrimTyCon IntRep []
1328 %************************************************************************
1330 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1332 %************************************************************************
1335 primOpInfo SeqOp -- seq# :: a -> Int#
1336 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1338 primOpInfo ParOp -- par# :: a -> Int#
1339 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1341 primOpInfo ForkOp -- fork# :: a -> Int#
1342 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1347 -- HWL: The first 4 Int# in all par... annotations denote:
1348 -- name, granularity info, size of result, degree of parallelism
1349 -- Same structure as _seq_ i.e. returns Int#
1351 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1352 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1354 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1355 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1357 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1358 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1360 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1361 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1363 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1364 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1366 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1367 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1369 primOpInfo CopyableOp -- copyable# :: a -> a
1370 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1372 primOpInfo NoFollowOp -- noFollow# :: a -> a
1373 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1376 %************************************************************************
1378 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1380 %************************************************************************
1383 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1384 primOpInfo ErrorIOPrimOp
1385 = PrimResult SLIT("errorIO#") [alphaTyVar]
1386 [mkFunTy realWorldStatePrimTy alphaTy]
1387 statePrimTyCon VoidRep [realWorldTy]
1390 %************************************************************************
1392 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1394 %************************************************************************
1397 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1398 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1400 (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
1403 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1407 %************************************************************************
1409 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1411 %************************************************************************
1413 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1414 with @Integers@ can trigger GC. Here we describe the heap requirements
1415 of the various @PrimOps@. For most, no heap is required. For a few,
1416 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1417 be combined with the rest of the heap usage in the basic block. For an
1418 unfortunate few, some unknown amount of heap is required (these are the
1419 ops which can trigger GC).
1422 data HeapRequirement
1424 | FixedHeapRequired HeapOffset
1425 | VariableHeapRequired
1427 primOpHeapReq :: PrimOp -> HeapRequirement
1429 primOpHeapReq NewArrayOp = VariableHeapRequired
1430 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1432 primOpHeapReq IntegerAddOp = VariableHeapRequired
1433 primOpHeapReq IntegerSubOp = VariableHeapRequired
1434 primOpHeapReq IntegerMulOp = VariableHeapRequired
1435 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1436 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1437 primOpHeapReq IntegerNegOp = VariableHeapRequired
1438 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1439 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1440 (intOff mIN_MP_INT_SIZE))
1441 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1442 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1443 (intOff mIN_MP_INT_SIZE))
1444 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1445 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1446 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1447 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1448 (intOff mIN_MP_INT_SIZE)))
1449 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1450 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1451 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1452 (intOff mIN_MP_INT_SIZE)))
1455 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1456 or if it returns a ForeignObj.
1458 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1459 why dod we need to be so indeterminate about it? --SOF
1461 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1462 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1464 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1465 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1467 -- this occasionally has to expand the Stable Pointer table
1468 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1470 -- These four only need heap space with the native code generator
1471 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1473 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1474 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1475 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1476 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1478 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1479 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1480 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1482 -- Sparking ops no longer allocate any heap; however, _fork_ may
1483 -- require a context switch to clear space in the required thread
1484 -- pool, and that requires liveness information.
1486 primOpHeapReq ParOp = NoHeapRequired
1487 primOpHeapReq ForkOp = VariableHeapRequired
1489 -- A SeqOp requires unknown space to evaluate its argument
1490 primOpHeapReq SeqOp = VariableHeapRequired
1492 -- GranSim sparks are stgMalloced i.e. no heap required
1493 primOpHeapReq ParGlobalOp = NoHeapRequired
1494 primOpHeapReq ParLocalOp = NoHeapRequired
1495 primOpHeapReq ParAtOp = NoHeapRequired
1496 primOpHeapReq ParAtAbsOp = NoHeapRequired
1497 primOpHeapReq ParAtRelOp = NoHeapRequired
1498 primOpHeapReq ParAtForNowOp = NoHeapRequired
1499 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1500 primOpHeapReq CopyableOp = NoHeapRequired
1501 primOpHeapReq NoFollowOp = NoHeapRequired
1503 primOpHeapReq other_op = NoHeapRequired
1506 The amount of stack required by primops.
1509 data StackRequirement
1511 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1512 | VariableStackRequired
1514 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1515 primOpStackRequired _ = VariableStackRequired
1516 -- ToDo: be more specific for certain primops (currently only used for seq)
1519 Primops which can trigger GC have to be called carefully.
1520 In particular, their arguments are guaranteed to be in registers,
1521 and a liveness mask tells which regs are live.
1524 primOpCanTriggerGC op
1532 case primOpHeapReq op of
1533 VariableHeapRequired -> True
1537 Sometimes we may choose to execute a PrimOp even though it isn't
1538 certain that its result will be required; ie execute them
1539 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1540 this is OK, because PrimOps are usually cheap, but it isn't OK for
1541 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1543 See also @primOpIsCheap@ (below).
1545 There should be no worries about side effects; that's all taken care
1546 of by data dependencies.
1549 primOpOkForSpeculation :: PrimOp -> Bool
1552 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1553 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1556 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1557 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1559 -- Float. ToDo: tan? tanh?
1560 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1561 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1562 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1563 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1565 -- Double. ToDo: tan? tanh?
1566 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1567 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1568 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1569 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1572 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1575 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1578 primOpOkForSpeculation ParOp = False -- Could be expensive!
1579 primOpOkForSpeculation ForkOp = False -- Likewise
1580 primOpOkForSpeculation SeqOp = False -- Likewise
1582 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1583 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1584 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1585 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1586 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1587 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1588 primOpOkForSpeculation CopyableOp = False -- only tags closure
1589 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1591 -- The default is "yes it's ok for speculation"
1592 primOpOkForSpeculation other_op = True
1595 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1596 WARNING), we just borrow some other predicates for a
1597 what-should-be-good-enough test.
1600 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1603 And some primops have side-effects and so, for example, must not be
1607 fragilePrimOp :: PrimOp -> Bool
1609 fragilePrimOp ParOp = True
1610 fragilePrimOp ForkOp = True
1611 fragilePrimOp SeqOp = True
1612 fragilePrimOp MakeForeignObjOp = True -- SOF
1613 fragilePrimOp WriteForeignObjOp = True -- SOF
1614 fragilePrimOp MakeStablePtrOp = True
1615 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1617 fragilePrimOp ParGlobalOp = True
1618 fragilePrimOp ParLocalOp = True
1619 fragilePrimOp ParAtOp = True
1620 fragilePrimOp ParAtAbsOp = True
1621 fragilePrimOp ParAtRelOp = True
1622 fragilePrimOp ParAtForNowOp = True
1623 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1624 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1626 fragilePrimOp other = False
1629 Primitive operations that perform calls need wrappers to save any live variables
1630 that are stored in caller-saves registers
1633 primOpNeedsWrapper :: PrimOp -> Bool
1635 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1637 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1638 primOpNeedsWrapper (NewByteArrayOp _) = True
1640 primOpNeedsWrapper IntegerAddOp = True
1641 primOpNeedsWrapper IntegerSubOp = True
1642 primOpNeedsWrapper IntegerMulOp = True
1643 primOpNeedsWrapper IntegerQuotRemOp = True
1644 primOpNeedsWrapper IntegerDivModOp = True
1645 primOpNeedsWrapper IntegerNegOp = True
1646 primOpNeedsWrapper IntegerCmpOp = True
1647 primOpNeedsWrapper Integer2IntOp = True
1648 primOpNeedsWrapper Int2IntegerOp = True
1649 primOpNeedsWrapper Word2IntegerOp = True
1650 primOpNeedsWrapper Addr2IntegerOp = True
1652 primOpNeedsWrapper FloatExpOp = True
1653 primOpNeedsWrapper FloatLogOp = True
1654 primOpNeedsWrapper FloatSqrtOp = True
1655 primOpNeedsWrapper FloatSinOp = True
1656 primOpNeedsWrapper FloatCosOp = True
1657 primOpNeedsWrapper FloatTanOp = True
1658 primOpNeedsWrapper FloatAsinOp = True
1659 primOpNeedsWrapper FloatAcosOp = True
1660 primOpNeedsWrapper FloatAtanOp = True
1661 primOpNeedsWrapper FloatSinhOp = True
1662 primOpNeedsWrapper FloatCoshOp = True
1663 primOpNeedsWrapper FloatTanhOp = True
1664 primOpNeedsWrapper FloatPowerOp = True
1665 primOpNeedsWrapper FloatEncodeOp = True
1666 primOpNeedsWrapper FloatDecodeOp = True
1668 primOpNeedsWrapper DoubleExpOp = True
1669 primOpNeedsWrapper DoubleLogOp = True
1670 primOpNeedsWrapper DoubleSqrtOp = True
1671 primOpNeedsWrapper DoubleSinOp = True
1672 primOpNeedsWrapper DoubleCosOp = True
1673 primOpNeedsWrapper DoubleTanOp = True
1674 primOpNeedsWrapper DoubleAsinOp = True
1675 primOpNeedsWrapper DoubleAcosOp = True
1676 primOpNeedsWrapper DoubleAtanOp = True
1677 primOpNeedsWrapper DoubleSinhOp = True
1678 primOpNeedsWrapper DoubleCoshOp = True
1679 primOpNeedsWrapper DoubleTanhOp = True
1680 primOpNeedsWrapper DoublePowerOp = True
1681 primOpNeedsWrapper DoubleEncodeOp = True
1682 primOpNeedsWrapper DoubleDecodeOp = True
1684 primOpNeedsWrapper MakeForeignObjOp = True
1685 primOpNeedsWrapper WriteForeignObjOp = True
1686 primOpNeedsWrapper MakeStablePtrOp = True
1687 primOpNeedsWrapper DeRefStablePtrOp = True
1689 primOpNeedsWrapper TakeMVarOp = True
1690 primOpNeedsWrapper PutMVarOp = True
1691 primOpNeedsWrapper ReadIVarOp = True
1693 primOpNeedsWrapper DelayOp = True
1694 primOpNeedsWrapper WaitReadOp = True
1695 primOpNeedsWrapper WaitWriteOp = True
1697 primOpNeedsWrapper other_op = False
1702 = case (primOpInfo op) of
1704 Monadic str _ -> str
1705 Compare str _ -> str
1706 Coercing str _ _ -> str
1707 PrimResult str _ _ _ _ _ -> str
1708 AlgResult str _ _ _ _ -> str
1711 @primOpType@ duplicates some work of @primOpId@, but since we
1712 grab types pretty often...
1714 primOpType :: PrimOp -> Type
1717 = case (primOpInfo op) of
1718 Dyadic str ty -> dyadic_fun_ty ty
1719 Monadic str ty -> monadic_fun_ty ty
1720 Compare str ty -> compare_fun_ty ty
1721 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1723 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1724 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1726 AlgResult str tyvars arg_tys tycon res_tys ->
1727 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1731 data PrimOpResultInfo
1732 = ReturnsPrim PrimRep
1735 -- ToDo: Deal with specialised PrimOps
1736 -- Will need to return specialised tycon and data constructors
1738 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1740 getPrimOpResultInfo op
1741 = case (primOpInfo op) of
1742 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1743 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1744 Compare _ ty -> ReturnsAlg boolTyCon
1745 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1746 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1747 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1749 isCompareOp :: PrimOp -> Bool
1752 = case primOpInfo op of
1757 The commutable ops are those for which we will try to move constants
1758 to the right hand side for strength reduction.
1761 commutableOp :: PrimOp -> Bool
1763 commutableOp CharEqOp = True
1764 commutableOp CharNeOp = True
1765 commutableOp IntAddOp = True
1766 commutableOp IntMulOp = True
1767 commutableOp AndOp = True
1768 commutableOp OrOp = True
1769 commutableOp XorOp = True
1770 commutableOp IntEqOp = True
1771 commutableOp IntNeOp = True
1772 commutableOp IntegerAddOp = True
1773 commutableOp IntegerMulOp = True
1774 commutableOp FloatAddOp = True
1775 commutableOp FloatMulOp = True
1776 commutableOp FloatEqOp = True
1777 commutableOp FloatNeOp = True
1778 commutableOp DoubleAddOp = True
1779 commutableOp DoubleMulOp = True
1780 commutableOp DoubleEqOp = True
1781 commutableOp DoubleNeOp = True
1782 commutableOp _ = False
1787 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1788 monadic_fun_ty ty = mkFunTy ty ty
1789 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1794 pprPrimOp :: PprStyle -> PrimOp -> Doc
1795 showPrimOp :: PprStyle -> PrimOp -> String
1797 showPrimOp sty op = render (pprPrimOp sty op)
1799 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1803 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1805 if may_gc then "_ccall_GC_ " else "_ccall_ "
1808 = if is_casm then text "''" else empty
1811 = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
1813 hcat [text before, ptext fun, after, space, brackets pp_tys]
1815 pprPrimOp sty other_op
1816 | codeStyle sty -- For C just print the primop itself
1819 | ifaceStyle sty -- For interfaces Print it qualified with GHC.
1820 = ptext SLIT("GHC.") <> ptext str
1822 | otherwise -- Unqualified is good enough
1825 str = primOp_str other_op
1829 instance Outputable PrimOp where
1830 ppr sty op = pprPrimOp sty op