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 | 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( 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 Int2IntegerOp = ILIT(114)
376 tagOf_PrimOp Word2IntegerOp = ILIT(115)
377 tagOf_PrimOp Addr2IntegerOp = ILIT(116)
378 tagOf_PrimOp FloatEncodeOp = ILIT(117)
379 tagOf_PrimOp FloatDecodeOp = ILIT(118)
380 tagOf_PrimOp DoubleEncodeOp = ILIT(119)
381 tagOf_PrimOp DoubleDecodeOp = ILIT(120)
382 tagOf_PrimOp NewArrayOp = ILIT(121)
383 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(122)
384 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(123)
385 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(124)
386 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(125)
387 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(126)
388 tagOf_PrimOp SameMutableArrayOp = ILIT(127)
389 tagOf_PrimOp SameMutableByteArrayOp = ILIT(128)
390 tagOf_PrimOp ReadArrayOp = ILIT(129)
391 tagOf_PrimOp WriteArrayOp = ILIT(130)
392 tagOf_PrimOp IndexArrayOp = ILIT(131)
393 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(132)
394 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(133)
395 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(134)
396 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(135)
397 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(136)
398 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(137)
399 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(138)
400 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(139)
401 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(140)
402 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(141)
403 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(142)
404 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(143)
405 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(144)
406 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(145)
407 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(146)
408 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(147)
409 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(148)
410 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(149)
411 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(150)
412 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(151)
413 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(152)
414 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(153)
415 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(154)
416 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(155)
417 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(156)
418 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(157)
419 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(158)
420 tagOf_PrimOp NewSynchVarOp = ILIT(159)
421 tagOf_PrimOp TakeMVarOp = ILIT(160)
422 tagOf_PrimOp PutMVarOp = ILIT(161)
423 tagOf_PrimOp ReadIVarOp = ILIT(162)
424 tagOf_PrimOp WriteIVarOp = ILIT(163)
425 tagOf_PrimOp MakeForeignObjOp = ILIT(164)
426 tagOf_PrimOp WriteForeignObjOp = ILIT(165)
427 tagOf_PrimOp MakeStablePtrOp = ILIT(166)
428 tagOf_PrimOp DeRefStablePtrOp = ILIT(167)
429 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(168)
430 tagOf_PrimOp ErrorIOPrimOp = ILIT(169)
431 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(170)
432 tagOf_PrimOp SeqOp = ILIT(171)
433 tagOf_PrimOp ParOp = ILIT(172)
434 tagOf_PrimOp ForkOp = ILIT(173)
435 tagOf_PrimOp DelayOp = ILIT(174)
436 tagOf_PrimOp WaitReadOp = ILIT(175)
437 tagOf_PrimOp WaitWriteOp = ILIT(176)
438 tagOf_PrimOp ParGlobalOp = ILIT(177)
439 tagOf_PrimOp ParLocalOp = ILIT(178)
440 tagOf_PrimOp ParAtOp = ILIT(179)
441 tagOf_PrimOp ParAtAbsOp = ILIT(180)
442 tagOf_PrimOp ParAtRelOp = ILIT(181)
443 tagOf_PrimOp ParAtForNowOp = ILIT(182)
444 tagOf_PrimOp CopyableOp = ILIT(183)
445 tagOf_PrimOp NoFollowOp = ILIT(184)
447 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
449 instance Eq PrimOp where
450 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
453 An @Enum@-derived list would be better; meanwhile... (ToDo)
574 NewByteArrayOp CharRep,
575 NewByteArrayOp IntRep,
576 NewByteArrayOp AddrRep,
577 NewByteArrayOp FloatRep,
578 NewByteArrayOp DoubleRep,
580 SameMutableByteArrayOp,
584 ReadByteArrayOp CharRep,
585 ReadByteArrayOp IntRep,
586 ReadByteArrayOp AddrRep,
587 ReadByteArrayOp FloatRep,
588 ReadByteArrayOp DoubleRep,
589 WriteByteArrayOp CharRep,
590 WriteByteArrayOp IntRep,
591 WriteByteArrayOp AddrRep,
592 WriteByteArrayOp FloatRep,
593 WriteByteArrayOp DoubleRep,
594 IndexByteArrayOp CharRep,
595 IndexByteArrayOp IntRep,
596 IndexByteArrayOp AddrRep,
597 IndexByteArrayOp FloatRep,
598 IndexByteArrayOp DoubleRep,
599 IndexOffAddrOp CharRep,
600 IndexOffAddrOp IntRep,
601 IndexOffAddrOp AddrRep,
602 IndexOffAddrOp FloatRep,
603 IndexOffAddrOp DoubleRep,
604 IndexOffForeignObjOp CharRep,
605 IndexOffForeignObjOp IntRep,
606 IndexOffForeignObjOp AddrRep,
607 IndexOffForeignObjOp FloatRep,
608 IndexOffForeignObjOp DoubleRep,
610 UnsafeFreezeByteArrayOp,
621 ReallyUnsafePtrEqualityOp,
640 %************************************************************************
642 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
644 %************************************************************************
646 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
647 refer to the primitive operation. The conventional \tr{#}-for-
648 unboxed ops is added on later.
650 The reason for the funny characters in the names is so we do not
651 interfere with the programmer's Haskell name spaces.
653 We use @PrimKinds@ for the ``type'' information, because they're
654 (slightly) more convenient to use than @TyCons@.
657 = Dyadic FAST_STRING -- string :: T -> T -> T
659 | Monadic FAST_STRING -- string :: T -> T
661 | Compare FAST_STRING -- string :: T -> T -> Bool
663 | Coercing FAST_STRING -- string :: T1 -> T2
667 | PrimResult FAST_STRING
668 [TyVar] [Type] TyCon PrimRep [Type]
669 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
670 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
671 -- D# is a primitive type constructor.
672 -- (the kind is the same info as D#, in another convenient form)
674 | AlgResult FAST_STRING
675 [TyVar] [Type] TyCon [Type]
676 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
677 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
679 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
684 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
686 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
687 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
688 an_Integer_and_Int_tys
689 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
692 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
694 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
696 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
698 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
701 @primOpInfo@ gives all essential information (from which everything
702 else, notably a type, can be constructed) for each @PrimOp@.
705 primOpInfo :: PrimOp -> PrimOpInfo
708 There's plenty of this stuff!
710 %************************************************************************
712 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
714 %************************************************************************
717 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
718 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
719 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
720 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
721 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
722 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
724 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
725 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
726 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
727 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
728 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
729 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
731 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
732 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
733 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
734 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
735 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
736 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
738 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
739 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
740 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
741 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
742 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
743 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
745 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
746 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
747 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
748 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
749 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
750 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
752 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
753 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
754 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
755 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
756 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
757 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
760 %************************************************************************
762 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
764 %************************************************************************
767 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
768 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
771 %************************************************************************
773 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
775 %************************************************************************
778 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
779 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
780 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
781 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
782 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
784 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
785 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
788 %************************************************************************
790 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
792 %************************************************************************
794 A @Word#@ is an unsigned @Int#@.
797 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
798 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
800 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
801 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
802 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
803 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
806 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
808 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
810 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
813 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
815 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
817 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
819 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
820 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
823 %************************************************************************
825 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
827 %************************************************************************
830 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
831 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
834 %************************************************************************
836 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
838 %************************************************************************
840 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
844 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
845 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
846 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
847 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
848 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
850 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
851 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
853 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
854 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
855 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
856 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
857 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
858 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
859 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
860 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
861 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
862 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
863 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
864 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
865 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
868 %************************************************************************
870 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
872 %************************************************************************
874 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
878 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
879 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
880 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
881 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
882 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
884 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
885 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
887 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
888 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
890 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
891 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
892 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
893 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
894 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
895 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
896 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
897 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
898 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
899 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
900 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
901 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
902 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
905 %************************************************************************
907 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
909 %************************************************************************
912 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
914 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
915 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
916 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
918 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
920 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
921 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
923 primOpInfo Integer2IntOp
924 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
926 primOpInfo Int2IntegerOp
927 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
929 primOpInfo Word2IntegerOp
930 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
932 primOpInfo Addr2IntegerOp
933 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
936 Encoding and decoding of floating-point numbers is sorta
940 primOpInfo FloatEncodeOp
941 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
942 floatPrimTyCon FloatRep []
944 primOpInfo DoubleEncodeOp
945 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
946 doublePrimTyCon DoubleRep []
948 primOpInfo FloatDecodeOp
949 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
951 primOpInfo DoubleDecodeOp
952 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
955 %************************************************************************
957 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
959 %************************************************************************
962 primOpInfo NewArrayOp
964 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
966 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
967 stateAndMutableArrayPrimTyCon [s, elt]
969 primOpInfo (NewByteArrayOp kind)
971 s = alphaTy; s_tv = alphaTyVar
973 (str, _, prim_tycon) = getPrimRepInfo kind
975 op_str = _PK_ ("new" ++ str ++ "Array#")
977 AlgResult op_str [s_tv]
978 [intPrimTy, mkStatePrimTy s]
979 stateAndMutableByteArrayPrimTyCon [s]
981 ---------------------------------------------------------------------------
983 primOpInfo SameMutableArrayOp
985 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
986 mut_arr_ty = mkMutableArrayPrimTy s elt
988 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
991 primOpInfo SameMutableByteArrayOp
993 s = alphaTy; s_tv = alphaTyVar;
994 mut_arr_ty = mkMutableByteArrayPrimTy s
996 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
999 ---------------------------------------------------------------------------
1000 -- Primitive arrays of Haskell pointers:
1002 primOpInfo ReadArrayOp
1004 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1006 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1007 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1008 stateAndPtrPrimTyCon [s, elt]
1011 primOpInfo WriteArrayOp
1013 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1015 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1016 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1017 statePrimTyCon VoidRep [s]
1019 primOpInfo IndexArrayOp
1020 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1021 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1024 ---------------------------------------------------------------------------
1025 -- Primitive arrays full of unboxed bytes:
1027 primOpInfo (ReadByteArrayOp kind)
1029 s = alphaTy; s_tv = alphaTyVar
1031 (str, _, prim_tycon) = getPrimRepInfo kind
1033 op_str = _PK_ ("read" ++ str ++ "Array#")
1034 relevant_tycon = assoc "primOpInfo" tbl kind
1036 AlgResult op_str [s_tv]
1037 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1040 tbl = [ (CharRep, stateAndCharPrimTyCon),
1041 (IntRep, stateAndIntPrimTyCon),
1042 (AddrRep, stateAndAddrPrimTyCon),
1043 (FloatRep, stateAndFloatPrimTyCon),
1044 (DoubleRep, stateAndDoublePrimTyCon) ]
1046 -- How come there's no Word byte arrays? ADR
1048 primOpInfo (WriteByteArrayOp kind)
1050 s = alphaTy; s_tv = alphaTyVar
1052 (str, prim_ty, _) = getPrimRepInfo kind
1053 op_str = _PK_ ("write" ++ str ++ "Array#")
1055 -- NB: *Prim*Result --
1056 PrimResult op_str [s_tv]
1057 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1058 statePrimTyCon VoidRep [s]
1060 primOpInfo (IndexByteArrayOp kind)
1062 (str, _, prim_tycon) = getPrimRepInfo kind
1063 op_str = _PK_ ("index" ++ str ++ "Array#")
1065 -- NB: *Prim*Result --
1066 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1068 primOpInfo (IndexOffAddrOp kind)
1070 (str, _, prim_tycon) = getPrimRepInfo kind
1071 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1073 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1075 primOpInfo (IndexOffForeignObjOp kind)
1077 (str, _, prim_tycon) = getPrimRepInfo kind
1078 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1080 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1082 ---------------------------------------------------------------------------
1083 primOpInfo UnsafeFreezeArrayOp
1085 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1087 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1088 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1089 stateAndArrayPrimTyCon [s, elt]
1091 primOpInfo UnsafeFreezeByteArrayOp
1092 = let { s = alphaTy; s_tv = alphaTyVar } in
1093 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1094 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1095 stateAndByteArrayPrimTyCon [s]
1098 %************************************************************************
1100 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1102 %************************************************************************
1105 primOpInfo NewSynchVarOp
1107 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1109 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1110 stateAndSynchVarPrimTyCon [s, elt]
1112 primOpInfo TakeMVarOp
1114 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1116 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1117 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1118 stateAndPtrPrimTyCon [s, elt]
1120 primOpInfo PutMVarOp
1122 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1124 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1125 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1128 primOpInfo ReadIVarOp
1130 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1132 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1133 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1134 stateAndPtrPrimTyCon [s, elt]
1136 primOpInfo WriteIVarOp
1138 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1140 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1141 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1146 %************************************************************************
1148 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1150 %************************************************************************
1156 s = alphaTy; s_tv = alphaTyVar
1158 PrimResult SLIT("delay#") [s_tv]
1159 [intPrimTy, mkStatePrimTy s]
1160 statePrimTyCon VoidRep [s]
1162 primOpInfo WaitReadOp
1164 s = alphaTy; s_tv = alphaTyVar
1166 PrimResult SLIT("waitRead#") [s_tv]
1167 [intPrimTy, mkStatePrimTy s]
1168 statePrimTyCon VoidRep [s]
1170 primOpInfo WaitWriteOp
1172 s = alphaTy; s_tv = alphaTyVar
1174 PrimResult SLIT("waitWrite#") [s_tv]
1175 [intPrimTy, mkStatePrimTy s]
1176 statePrimTyCon VoidRep [s]
1179 %************************************************************************
1181 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1183 %************************************************************************
1185 Not everything should/can be in the Haskell heap. As an example, in an
1186 image processing application written in Haskell, you really would like
1187 to avoid heaving huge images between different space or generations of
1188 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1189 which refer to some externally allocated structure/value. Using @ForeignObj@,
1190 just a reference to an image is present in the heap, the image could then
1191 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1192 a completely separate address space alltogether.
1194 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1195 associated with the object is invoked (currently, each ForeignObj has a
1196 direct reference to its finaliser). -- SOF
1198 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1201 makeForeignObj# :: Addr# -- foreign object
1202 -> Addr# -- ptr to its finaliser routine
1203 -> StateAndForeignObj# _RealWorld# ForeignObj#
1208 primOpInfo MakeForeignObjOp
1209 = AlgResult SLIT("makeForeignObj#") []
1210 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1211 stateAndForeignObjPrimTyCon [realWorldTy]
1215 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1216 the external object wrapped up inside a @ForeignObj@. This primitive is used
1217 when a mixed programming interface of implicit and explicit de-allocation is used,
1218 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1219 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1220 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1221 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1222 We deal with this situation, by allowing the programmer to destructively modify
1223 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1224 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1227 writeForeignObj# :: ForeignObj# -- foreign object
1228 -> Addr# -- new data value
1229 -> StateAndForeignObj# _RealWorld# ForeignObj#
1233 primOpInfo WriteForeignObjOp
1235 s = alphaTy; s_tv = alphaTyVar
1237 PrimResult SLIT("writeForeignObj#") [s_tv]
1238 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1239 statePrimTyCon VoidRep [s]
1242 %************************************************************************
1244 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1246 %************************************************************************
1248 A {\em stable pointer} is an index into a table of pointers into the
1249 heap. Since the garbage collector is told about stable pointers, it
1250 is safe to pass a stable pointer to external systems such as C
1253 Here's what the operations and types are supposed to be (from
1254 state-interface document).
1257 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1258 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1259 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1262 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1263 operation since it doesn't (directly) involve IO operations. The
1264 reason is that if some optimisation pass decided to duplicate calls to
1265 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1266 massive space leak can result. Putting it into the PrimIO monad
1267 prevents this. (Another reason for putting them in a monad is to
1268 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1271 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1272 besides, it's not likely to be used from Haskell) so it's not a
1275 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1278 primOpInfo MakeStablePtrOp
1279 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1280 [alphaTy, realWorldStatePrimTy]
1281 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1283 primOpInfo DeRefStablePtrOp
1284 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1285 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1286 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1289 %************************************************************************
1291 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1293 %************************************************************************
1295 [Alastair Reid is to blame for this!]
1297 These days, (Glasgow) Haskell seems to have a bit of everything from
1298 other languages: strict operations, mutable variables, sequencing,
1299 pointers, etc. About the only thing left is LISP's ability to test
1300 for pointer equality. So, let's add it in!
1303 reallyUnsafePtrEquality :: a -> a -> Int#
1306 which tests any two closures (of the same type) to see if they're the
1307 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1308 difficulties of trying to box up the result.)
1310 NB This is {\em really unsafe\/} because even something as trivial as
1311 a garbage collection might change the answer by removing indirections.
1312 Still, no-one's forcing you to use it. If you're worried about little
1313 things like loss of referential transparency, you might like to wrap
1314 it all up in a monad-like thing as John O'Donnell and John Hughes did
1315 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1318 I'm thinking of using it to speed up a critical equality test in some
1319 graphics stuff in a context where the possibility of saying that
1320 denotationally equal things aren't isn't a problem (as long as it
1321 doesn't happen too often.) ADR
1323 To Will: Jim said this was already in, but I can't see it so I'm
1324 adding it. Up to you whether you add it. (Note that this could have
1325 been readily implemented using a @veryDangerousCCall@ before they were
1329 primOpInfo ReallyUnsafePtrEqualityOp
1330 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1331 [alphaTy, alphaTy] intPrimTyCon IntRep []
1334 %************************************************************************
1336 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1338 %************************************************************************
1341 primOpInfo SeqOp -- seq# :: a -> Int#
1342 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1344 primOpInfo ParOp -- par# :: a -> Int#
1345 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1347 primOpInfo ForkOp -- fork# :: a -> Int#
1348 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1353 -- HWL: The first 4 Int# in all par... annotations denote:
1354 -- name, granularity info, size of result, degree of parallelism
1355 -- Same structure as _seq_ i.e. returns Int#
1357 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1358 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1360 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1361 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1363 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1364 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1366 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1367 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1369 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1370 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1372 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1373 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1375 primOpInfo CopyableOp -- copyable# :: a -> a
1376 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1378 primOpInfo NoFollowOp -- noFollow# :: a -> a
1379 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1382 %************************************************************************
1384 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1386 %************************************************************************
1389 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1390 primOpInfo ErrorIOPrimOp
1391 = PrimResult SLIT("errorIO#") [alphaTyVar]
1392 [mkFunTy realWorldStatePrimTy alphaTy]
1393 statePrimTyCon VoidRep [realWorldTy]
1396 %************************************************************************
1398 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1400 %************************************************************************
1403 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1404 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1406 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1409 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1413 %************************************************************************
1415 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1417 %************************************************************************
1419 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1420 with @Integers@ can trigger GC. Here we describe the heap requirements
1421 of the various @PrimOps@. For most, no heap is required. For a few,
1422 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1423 be combined with the rest of the heap usage in the basic block. For an
1424 unfortunate few, some unknown amount of heap is required (these are the
1425 ops which can trigger GC).
1428 data HeapRequirement
1430 | FixedHeapRequired HeapOffset
1431 | VariableHeapRequired
1433 primOpHeapReq :: PrimOp -> HeapRequirement
1435 primOpHeapReq NewArrayOp = VariableHeapRequired
1436 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1438 primOpHeapReq IntegerAddOp = VariableHeapRequired
1439 primOpHeapReq IntegerSubOp = VariableHeapRequired
1440 primOpHeapReq IntegerMulOp = VariableHeapRequired
1441 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1442 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1443 primOpHeapReq IntegerNegOp = VariableHeapRequired
1444 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1445 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1446 (intOff mIN_MP_INT_SIZE))
1447 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1448 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1449 (intOff mIN_MP_INT_SIZE))
1450 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1451 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1452 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1453 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1454 (intOff mIN_MP_INT_SIZE)))
1455 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1456 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1457 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1458 (intOff mIN_MP_INT_SIZE)))
1461 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1462 or if it returns a ForeignObj.
1464 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1465 why dod we need to be so indeterminate about it? --SOF
1467 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1468 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1470 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1471 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1473 -- this occasionally has to expand the Stable Pointer table
1474 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1476 -- These four only need heap space with the native code generator
1477 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1479 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1480 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1481 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1482 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1484 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1485 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1486 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1488 -- Sparking ops no longer allocate any heap; however, _fork_ may
1489 -- require a context switch to clear space in the required thread
1490 -- pool, and that requires liveness information.
1492 primOpHeapReq ParOp = NoHeapRequired
1493 primOpHeapReq ForkOp = VariableHeapRequired
1495 -- A SeqOp requires unknown space to evaluate its argument
1496 primOpHeapReq SeqOp = VariableHeapRequired
1498 -- GranSim sparks are stgMalloced i.e. no heap required
1499 primOpHeapReq ParGlobalOp = NoHeapRequired
1500 primOpHeapReq ParLocalOp = NoHeapRequired
1501 primOpHeapReq ParAtOp = NoHeapRequired
1502 primOpHeapReq ParAtAbsOp = NoHeapRequired
1503 primOpHeapReq ParAtRelOp = NoHeapRequired
1504 primOpHeapReq ParAtForNowOp = NoHeapRequired
1505 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1506 primOpHeapReq CopyableOp = NoHeapRequired
1507 primOpHeapReq NoFollowOp = NoHeapRequired
1509 primOpHeapReq other_op = NoHeapRequired
1512 The amount of stack required by primops.
1515 data StackRequirement
1517 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1518 | VariableStackRequired
1520 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1521 primOpStackRequired _ = VariableStackRequired
1522 -- ToDo: be more specific for certain primops (currently only used for seq)
1525 Primops which can trigger GC have to be called carefully.
1526 In particular, their arguments are guaranteed to be in registers,
1527 and a liveness mask tells which regs are live.
1530 primOpCanTriggerGC op
1538 case primOpHeapReq op of
1539 VariableHeapRequired -> True
1543 Sometimes we may choose to execute a PrimOp even though it isn't
1544 certain that its result will be required; ie execute them
1545 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1546 this is OK, because PrimOps are usually cheap, but it isn't OK for
1547 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1549 See also @primOpIsCheap@ (below).
1551 There should be no worries about side effects; that's all taken care
1552 of by data dependencies.
1555 primOpOkForSpeculation :: PrimOp -> Bool
1558 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1559 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1562 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1563 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1565 -- Float. ToDo: tan? tanh?
1566 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1567 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1568 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1569 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1571 -- Double. ToDo: tan? tanh?
1572 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1573 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1574 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1575 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1578 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1581 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1584 primOpOkForSpeculation ParOp = False -- Could be expensive!
1585 primOpOkForSpeculation ForkOp = False -- Likewise
1586 primOpOkForSpeculation SeqOp = False -- Likewise
1588 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1589 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1590 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1591 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1592 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1593 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1594 primOpOkForSpeculation CopyableOp = False -- only tags closure
1595 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1597 -- The default is "yes it's ok for speculation"
1598 primOpOkForSpeculation other_op = True
1601 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1602 WARNING), we just borrow some other predicates for a
1603 what-should-be-good-enough test.
1606 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1609 And some primops have side-effects and so, for example, must not be
1613 fragilePrimOp :: PrimOp -> Bool
1615 fragilePrimOp ParOp = True
1616 fragilePrimOp ForkOp = True
1617 fragilePrimOp SeqOp = True
1618 fragilePrimOp MakeForeignObjOp = True -- SOF
1619 fragilePrimOp WriteForeignObjOp = True -- SOF
1620 fragilePrimOp MakeStablePtrOp = True
1621 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1623 fragilePrimOp ParGlobalOp = True
1624 fragilePrimOp ParLocalOp = True
1625 fragilePrimOp ParAtOp = True
1626 fragilePrimOp ParAtAbsOp = True
1627 fragilePrimOp ParAtRelOp = True
1628 fragilePrimOp ParAtForNowOp = True
1629 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1630 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1632 fragilePrimOp other = False
1635 Primitive operations that perform calls need wrappers to save any live variables
1636 that are stored in caller-saves registers
1639 primOpNeedsWrapper :: PrimOp -> Bool
1641 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1643 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1644 primOpNeedsWrapper (NewByteArrayOp _) = True
1646 primOpNeedsWrapper IntegerAddOp = True
1647 primOpNeedsWrapper IntegerSubOp = True
1648 primOpNeedsWrapper IntegerMulOp = True
1649 primOpNeedsWrapper IntegerQuotRemOp = True
1650 primOpNeedsWrapper IntegerDivModOp = True
1651 primOpNeedsWrapper IntegerNegOp = True
1652 primOpNeedsWrapper IntegerCmpOp = True
1653 primOpNeedsWrapper Integer2IntOp = True
1654 primOpNeedsWrapper Int2IntegerOp = True
1655 primOpNeedsWrapper Word2IntegerOp = True
1656 primOpNeedsWrapper Addr2IntegerOp = True
1658 primOpNeedsWrapper FloatExpOp = True
1659 primOpNeedsWrapper FloatLogOp = True
1660 primOpNeedsWrapper FloatSqrtOp = True
1661 primOpNeedsWrapper FloatSinOp = True
1662 primOpNeedsWrapper FloatCosOp = True
1663 primOpNeedsWrapper FloatTanOp = True
1664 primOpNeedsWrapper FloatAsinOp = True
1665 primOpNeedsWrapper FloatAcosOp = True
1666 primOpNeedsWrapper FloatAtanOp = True
1667 primOpNeedsWrapper FloatSinhOp = True
1668 primOpNeedsWrapper FloatCoshOp = True
1669 primOpNeedsWrapper FloatTanhOp = True
1670 primOpNeedsWrapper FloatPowerOp = True
1671 primOpNeedsWrapper FloatEncodeOp = True
1672 primOpNeedsWrapper FloatDecodeOp = True
1674 primOpNeedsWrapper DoubleExpOp = True
1675 primOpNeedsWrapper DoubleLogOp = True
1676 primOpNeedsWrapper DoubleSqrtOp = True
1677 primOpNeedsWrapper DoubleSinOp = True
1678 primOpNeedsWrapper DoubleCosOp = True
1679 primOpNeedsWrapper DoubleTanOp = True
1680 primOpNeedsWrapper DoubleAsinOp = True
1681 primOpNeedsWrapper DoubleAcosOp = True
1682 primOpNeedsWrapper DoubleAtanOp = True
1683 primOpNeedsWrapper DoubleSinhOp = True
1684 primOpNeedsWrapper DoubleCoshOp = True
1685 primOpNeedsWrapper DoubleTanhOp = True
1686 primOpNeedsWrapper DoublePowerOp = True
1687 primOpNeedsWrapper DoubleEncodeOp = True
1688 primOpNeedsWrapper DoubleDecodeOp = True
1690 primOpNeedsWrapper MakeForeignObjOp = True
1691 primOpNeedsWrapper WriteForeignObjOp = True
1692 primOpNeedsWrapper MakeStablePtrOp = True
1693 primOpNeedsWrapper DeRefStablePtrOp = True
1695 primOpNeedsWrapper TakeMVarOp = True
1696 primOpNeedsWrapper PutMVarOp = True
1697 primOpNeedsWrapper ReadIVarOp = True
1699 primOpNeedsWrapper DelayOp = True
1700 primOpNeedsWrapper WaitReadOp = True
1701 primOpNeedsWrapper WaitWriteOp = True
1703 primOpNeedsWrapper other_op = False
1708 = case (primOpInfo op) of
1710 Monadic str _ -> str
1711 Compare str _ -> str
1712 Coercing str _ _ -> str
1713 PrimResult str _ _ _ _ _ -> str
1714 AlgResult str _ _ _ _ -> str
1717 @primOpType@ duplicates some work of @primOpId@, but since we
1718 grab types pretty often...
1720 primOpType :: PrimOp -> Type
1723 = case (primOpInfo op) of
1724 Dyadic str ty -> dyadic_fun_ty ty
1725 Monadic str ty -> monadic_fun_ty ty
1726 Compare str ty -> compare_fun_ty ty
1727 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1729 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1730 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1732 AlgResult str tyvars arg_tys tycon res_tys ->
1733 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1737 data PrimOpResultInfo
1738 = ReturnsPrim PrimRep
1741 -- ToDo: Deal with specialised PrimOps
1742 -- Will need to return specialised tycon and data constructors
1744 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1746 getPrimOpResultInfo op
1747 = case (primOpInfo op) of
1748 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1749 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1750 Compare _ ty -> ReturnsAlg boolTyCon
1751 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1752 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1753 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1755 isCompareOp :: PrimOp -> Bool
1758 = case primOpInfo op of
1763 The commutable ops are those for which we will try to move constants
1764 to the right hand side for strength reduction.
1767 commutableOp :: PrimOp -> Bool
1769 commutableOp CharEqOp = True
1770 commutableOp CharNeOp = True
1771 commutableOp IntAddOp = True
1772 commutableOp IntMulOp = True
1773 commutableOp AndOp = True
1774 commutableOp OrOp = True
1775 commutableOp XorOp = True
1776 commutableOp IntEqOp = True
1777 commutableOp IntNeOp = True
1778 commutableOp IntegerAddOp = True
1779 commutableOp IntegerMulOp = True
1780 commutableOp FloatAddOp = True
1781 commutableOp FloatMulOp = True
1782 commutableOp FloatEqOp = True
1783 commutableOp FloatNeOp = True
1784 commutableOp DoubleAddOp = True
1785 commutableOp DoubleMulOp = True
1786 commutableOp DoubleEqOp = True
1787 commutableOp DoubleNeOp = True
1788 commutableOp _ = False
1793 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1794 monadic_fun_ty ty = mkFunTy ty ty
1795 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1800 pprPrimOp :: PrimOp -> SDoc
1801 showPrimOp :: PrimOp -> String
1803 showPrimOp op = showSDoc (pprPrimOp op)
1805 pprPrimOp (CCallOp fun is_casm may_gc arg_tys res_ty)
1809 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1811 if may_gc then "_ccall_GC_ " else "_ccall_ "
1814 = if is_casm then text "''" else empty
1817 = hsep (map pprParendGenType (res_ty:arg_tys))
1819 hcat [text before, ptext fun, after, space, brackets pp_tys]
1822 = getPprStyle $ \ sty ->
1823 if codeStyle sty then -- For C just print the primop itself
1825 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
1826 ptext SLIT("PrelGHC.") <> ptext str
1827 else -- Unqualified is good enough
1830 str = primOp_str other_op
1833 instance Outputable PrimOp where
1834 ppr op = pprPrimOp op