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
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 SllOp = ILIT( 50)
313 tagOf_PrimOp SraOp = ILIT( 51)
314 tagOf_PrimOp SrlOp = ILIT( 52)
315 tagOf_PrimOp ISllOp = ILIT( 53)
316 tagOf_PrimOp ISraOp = ILIT( 54)
317 tagOf_PrimOp ISrlOp = ILIT( 55)
318 tagOf_PrimOp Int2WordOp = ILIT( 56)
319 tagOf_PrimOp Word2IntOp = ILIT( 57)
320 tagOf_PrimOp Int2AddrOp = ILIT( 58)
321 tagOf_PrimOp Addr2IntOp = ILIT( 59)
322 tagOf_PrimOp FloatAddOp = ILIT( 60)
323 tagOf_PrimOp FloatSubOp = ILIT( 61)
324 tagOf_PrimOp FloatMulOp = ILIT( 62)
325 tagOf_PrimOp FloatDivOp = ILIT( 63)
326 tagOf_PrimOp FloatNegOp = ILIT( 64)
327 tagOf_PrimOp Float2IntOp = ILIT( 65)
328 tagOf_PrimOp Int2FloatOp = ILIT( 66)
329 tagOf_PrimOp FloatExpOp = ILIT( 67)
330 tagOf_PrimOp FloatLogOp = ILIT( 68)
331 tagOf_PrimOp FloatSqrtOp = ILIT( 69)
332 tagOf_PrimOp FloatSinOp = ILIT( 70)
333 tagOf_PrimOp FloatCosOp = ILIT( 71)
334 tagOf_PrimOp FloatTanOp = ILIT( 72)
335 tagOf_PrimOp FloatAsinOp = ILIT( 73)
336 tagOf_PrimOp FloatAcosOp = ILIT( 74)
337 tagOf_PrimOp FloatAtanOp = ILIT( 75)
338 tagOf_PrimOp FloatSinhOp = ILIT( 76)
339 tagOf_PrimOp FloatCoshOp = ILIT( 77)
340 tagOf_PrimOp FloatTanhOp = ILIT( 78)
341 tagOf_PrimOp FloatPowerOp = ILIT( 79)
342 tagOf_PrimOp DoubleAddOp = ILIT( 80)
343 tagOf_PrimOp DoubleSubOp = ILIT( 81)
344 tagOf_PrimOp DoubleMulOp = ILIT( 82)
345 tagOf_PrimOp DoubleDivOp = ILIT( 83)
346 tagOf_PrimOp DoubleNegOp = ILIT( 84)
347 tagOf_PrimOp Double2IntOp = ILIT( 85)
348 tagOf_PrimOp Int2DoubleOp = ILIT( 86)
349 tagOf_PrimOp Double2FloatOp = ILIT( 87)
350 tagOf_PrimOp Float2DoubleOp = ILIT( 88)
351 tagOf_PrimOp DoubleExpOp = ILIT( 89)
352 tagOf_PrimOp DoubleLogOp = ILIT( 90)
353 tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
354 tagOf_PrimOp DoubleSinOp = ILIT( 92)
355 tagOf_PrimOp DoubleCosOp = ILIT( 93)
356 tagOf_PrimOp DoubleTanOp = ILIT( 94)
357 tagOf_PrimOp DoubleAsinOp = ILIT( 95)
358 tagOf_PrimOp DoubleAcosOp = ILIT( 96)
359 tagOf_PrimOp DoubleAtanOp = ILIT( 97)
360 tagOf_PrimOp DoubleSinhOp = ILIT( 98)
361 tagOf_PrimOp DoubleCoshOp = ILIT( 99)
362 tagOf_PrimOp DoubleTanhOp = ILIT(100)
363 tagOf_PrimOp DoublePowerOp = ILIT(101)
364 tagOf_PrimOp IntegerAddOp = ILIT(102)
365 tagOf_PrimOp IntegerSubOp = ILIT(103)
366 tagOf_PrimOp IntegerMulOp = ILIT(104)
367 tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
368 tagOf_PrimOp IntegerDivModOp = ILIT(106)
369 tagOf_PrimOp IntegerNegOp = ILIT(107)
370 tagOf_PrimOp IntegerCmpOp = ILIT(108)
371 tagOf_PrimOp Integer2IntOp = ILIT(109)
372 tagOf_PrimOp Int2IntegerOp = ILIT(110)
373 tagOf_PrimOp Word2IntegerOp = ILIT(111)
374 tagOf_PrimOp Addr2IntegerOp = ILIT(112)
375 tagOf_PrimOp FloatEncodeOp = ILIT(113)
376 tagOf_PrimOp FloatDecodeOp = ILIT(114)
377 tagOf_PrimOp DoubleEncodeOp = ILIT(115)
378 tagOf_PrimOp DoubleDecodeOp = ILIT(116)
379 tagOf_PrimOp NewArrayOp = ILIT(117)
380 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
381 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
382 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
383 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
384 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
385 tagOf_PrimOp SameMutableArrayOp = ILIT(123)
386 tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
387 tagOf_PrimOp ReadArrayOp = ILIT(125)
388 tagOf_PrimOp WriteArrayOp = ILIT(126)
389 tagOf_PrimOp IndexArrayOp = ILIT(127)
390 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
391 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
392 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
393 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
394 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
395 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
396 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
397 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
398 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
399 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
400 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
401 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
402 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
403 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
404 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
405 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
406 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
407 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
408 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
409 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
410 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(148)
411 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(149)
412 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(150)
413 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(151)
414 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(152)
415 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(153)
416 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(154)
417 tagOf_PrimOp NewSynchVarOp = ILIT(155)
418 tagOf_PrimOp TakeMVarOp = ILIT(156)
419 tagOf_PrimOp PutMVarOp = ILIT(157)
420 tagOf_PrimOp ReadIVarOp = ILIT(158)
421 tagOf_PrimOp WriteIVarOp = ILIT(159)
422 tagOf_PrimOp MakeForeignObjOp = ILIT(160)
423 tagOf_PrimOp WriteForeignObjOp = ILIT(161)
424 tagOf_PrimOp MakeStablePtrOp = ILIT(162)
425 tagOf_PrimOp DeRefStablePtrOp = ILIT(163)
426 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(164)
427 tagOf_PrimOp ErrorIOPrimOp = ILIT(165)
428 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(166)
429 tagOf_PrimOp SeqOp = ILIT(167)
430 tagOf_PrimOp ParOp = ILIT(168)
431 tagOf_PrimOp ForkOp = ILIT(169)
432 tagOf_PrimOp DelayOp = ILIT(170)
433 tagOf_PrimOp WaitReadOp = ILIT(171)
434 tagOf_PrimOp WaitWriteOp = ILIT(172)
436 tagOf_PrimOp ParGlobalOp = ILIT(173)
437 tagOf_PrimOp ParLocalOp = ILIT(174)
438 tagOf_PrimOp ParAtOp = ILIT(175)
439 tagOf_PrimOp ParAtAbsOp = ILIT(176)
440 tagOf_PrimOp ParAtRelOp = ILIT(177)
441 tagOf_PrimOp ParAtForNowOp = ILIT(178)
442 tagOf_PrimOp CopyableOp = ILIT(179)
443 tagOf_PrimOp NoFollowOp = ILIT(180)
445 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
447 instance Eq PrimOp where
448 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
451 An @Enum@-derived list would be better; meanwhile... (ToDo)
569 NewByteArrayOp CharRep,
570 NewByteArrayOp IntRep,
571 NewByteArrayOp AddrRep,
572 NewByteArrayOp FloatRep,
573 NewByteArrayOp DoubleRep,
575 SameMutableByteArrayOp,
579 ReadByteArrayOp CharRep,
580 ReadByteArrayOp IntRep,
581 ReadByteArrayOp AddrRep,
582 ReadByteArrayOp FloatRep,
583 ReadByteArrayOp DoubleRep,
584 WriteByteArrayOp CharRep,
585 WriteByteArrayOp IntRep,
586 WriteByteArrayOp AddrRep,
587 WriteByteArrayOp FloatRep,
588 WriteByteArrayOp DoubleRep,
589 IndexByteArrayOp CharRep,
590 IndexByteArrayOp IntRep,
591 IndexByteArrayOp AddrRep,
592 IndexByteArrayOp FloatRep,
593 IndexByteArrayOp DoubleRep,
594 IndexOffAddrOp CharRep,
595 IndexOffAddrOp IntRep,
596 IndexOffAddrOp AddrRep,
597 IndexOffAddrOp FloatRep,
598 IndexOffAddrOp DoubleRep,
599 IndexOffForeignObjOp CharRep,
600 IndexOffForeignObjOp IntRep,
601 IndexOffForeignObjOp AddrRep,
602 IndexOffForeignObjOp FloatRep,
603 IndexOffForeignObjOp DoubleRep,
605 UnsafeFreezeByteArrayOp,
616 ReallyUnsafePtrEqualityOp,
635 %************************************************************************
637 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
639 %************************************************************************
641 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
642 refer to the primitive operation. The conventional \tr{#}-for-
643 unboxed ops is added on later.
645 The reason for the funny characters in the names is so we do not
646 interfere with the programmer's Haskell name spaces.
648 We use @PrimKinds@ for the ``type'' information, because they're
649 (slightly) more convenient to use than @TyCons@.
652 = Dyadic FAST_STRING -- string :: T -> T -> T
654 | Monadic FAST_STRING -- string :: T -> T
656 | Compare FAST_STRING -- string :: T -> T -> Bool
658 | Coercing FAST_STRING -- string :: T1 -> T2
662 | PrimResult FAST_STRING
663 [TyVar] [Type] TyCon PrimRep [Type]
664 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
665 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
666 -- D# is a primitive type constructor.
667 -- (the kind is the same info as D#, in another convenient form)
669 | AlgResult FAST_STRING
670 [TyVar] [Type] TyCon [Type]
671 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
672 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
674 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
679 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
681 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
682 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
683 an_Integer_and_Int_tys
684 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
687 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
689 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
691 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
693 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
696 @primOpInfo@ gives all essential information (from which everything
697 else, notably a type, can be constructed) for each @PrimOp@.
700 primOpInfo :: PrimOp -> PrimOpInfo
703 There's plenty of this stuff!
705 %************************************************************************
707 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
709 %************************************************************************
712 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
713 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
714 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
715 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
716 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
717 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
719 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
720 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
721 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
722 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
723 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
724 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
726 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
727 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
728 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
729 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
730 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
731 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
733 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
734 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
735 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
736 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
737 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
738 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
740 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
741 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
742 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
743 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
744 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
745 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
747 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
748 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
749 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
750 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
751 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
752 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
755 %************************************************************************
757 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
759 %************************************************************************
762 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
763 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
766 %************************************************************************
768 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
770 %************************************************************************
773 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
774 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
775 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
776 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
777 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
779 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
780 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
783 %************************************************************************
785 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
787 %************************************************************************
789 A @Word#@ is an unsigned @Int#@.
792 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
793 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
794 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
797 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
799 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
801 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
804 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
806 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
808 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
810 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
811 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
814 %************************************************************************
816 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
818 %************************************************************************
821 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
822 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
825 %************************************************************************
827 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
829 %************************************************************************
831 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
835 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
836 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
837 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
838 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
839 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
841 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
842 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
844 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
845 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
846 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
847 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
848 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
849 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
850 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
851 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
852 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
853 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
854 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
855 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
856 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
859 %************************************************************************
861 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
863 %************************************************************************
865 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
869 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
870 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
871 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
872 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
873 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
875 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
876 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
878 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
879 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
881 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
882 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
883 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
884 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
885 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
886 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
887 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
888 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
889 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
890 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
891 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
892 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
893 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
896 %************************************************************************
898 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
900 %************************************************************************
903 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
905 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
906 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
907 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
909 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
911 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
912 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
914 primOpInfo Integer2IntOp
915 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
917 primOpInfo Int2IntegerOp
918 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
920 primOpInfo Word2IntegerOp
921 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
923 primOpInfo Addr2IntegerOp
924 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
927 Encoding and decoding of floating-point numbers is sorta
931 primOpInfo FloatEncodeOp
932 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
933 floatPrimTyCon FloatRep []
935 primOpInfo DoubleEncodeOp
936 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
937 doublePrimTyCon DoubleRep []
939 primOpInfo FloatDecodeOp
940 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
942 primOpInfo DoubleDecodeOp
943 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
946 %************************************************************************
948 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
950 %************************************************************************
953 primOpInfo NewArrayOp
955 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
957 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
958 stateAndMutableArrayPrimTyCon [s, elt]
960 primOpInfo (NewByteArrayOp kind)
962 s = alphaTy; s_tv = alphaTyVar
964 (str, _, prim_tycon) = getPrimRepInfo kind
966 op_str = _PK_ ("new" ++ str ++ "Array#")
968 AlgResult op_str [s_tv]
969 [intPrimTy, mkStatePrimTy s]
970 stateAndMutableByteArrayPrimTyCon [s]
972 ---------------------------------------------------------------------------
974 primOpInfo SameMutableArrayOp
976 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
977 mut_arr_ty = mkMutableArrayPrimTy s elt
979 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
982 primOpInfo SameMutableByteArrayOp
984 s = alphaTy; s_tv = alphaTyVar;
985 mut_arr_ty = mkMutableByteArrayPrimTy s
987 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
990 ---------------------------------------------------------------------------
991 -- Primitive arrays of Haskell pointers:
993 primOpInfo ReadArrayOp
995 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
997 AlgResult SLIT("readArray#") [s_tv, elt_tv]
998 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
999 stateAndPtrPrimTyCon [s, elt]
1002 primOpInfo WriteArrayOp
1004 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1006 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1007 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1008 statePrimTyCon VoidRep [s]
1010 primOpInfo IndexArrayOp
1011 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1012 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1015 ---------------------------------------------------------------------------
1016 -- Primitive arrays full of unboxed bytes:
1018 primOpInfo (ReadByteArrayOp kind)
1020 s = alphaTy; s_tv = alphaTyVar
1022 (str, _, prim_tycon) = getPrimRepInfo kind
1024 op_str = _PK_ ("read" ++ str ++ "Array#")
1025 relevant_tycon = assoc "primOpInfo" tbl kind
1027 AlgResult op_str [s_tv]
1028 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1031 tbl = [ (CharRep, stateAndCharPrimTyCon),
1032 (IntRep, stateAndIntPrimTyCon),
1033 (AddrRep, stateAndAddrPrimTyCon),
1034 (FloatRep, stateAndFloatPrimTyCon),
1035 (DoubleRep, stateAndDoublePrimTyCon) ]
1037 -- How come there's no Word byte arrays? ADR
1039 primOpInfo (WriteByteArrayOp kind)
1041 s = alphaTy; s_tv = alphaTyVar
1043 (str, prim_ty, _) = getPrimRepInfo kind
1044 op_str = _PK_ ("write" ++ str ++ "Array#")
1046 -- NB: *Prim*Result --
1047 PrimResult op_str [s_tv]
1048 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1049 statePrimTyCon VoidRep [s]
1051 primOpInfo (IndexByteArrayOp kind)
1053 (str, _, prim_tycon) = getPrimRepInfo kind
1054 op_str = _PK_ ("index" ++ str ++ "Array#")
1056 -- NB: *Prim*Result --
1057 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1059 primOpInfo (IndexOffAddrOp kind)
1061 (str, _, prim_tycon) = getPrimRepInfo kind
1062 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1064 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1066 primOpInfo (IndexOffForeignObjOp kind)
1068 (str, _, prim_tycon) = getPrimRepInfo kind
1069 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1071 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1073 ---------------------------------------------------------------------------
1074 primOpInfo UnsafeFreezeArrayOp
1076 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1078 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1079 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1080 stateAndArrayPrimTyCon [s, elt]
1082 primOpInfo UnsafeFreezeByteArrayOp
1083 = let { s = alphaTy; s_tv = alphaTyVar } in
1084 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1085 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1086 stateAndByteArrayPrimTyCon [s]
1089 %************************************************************************
1091 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1093 %************************************************************************
1096 primOpInfo NewSynchVarOp
1098 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1100 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1101 stateAndSynchVarPrimTyCon [s, elt]
1103 primOpInfo TakeMVarOp
1105 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1107 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1108 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1109 stateAndPtrPrimTyCon [s, elt]
1111 primOpInfo PutMVarOp
1113 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1115 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1116 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1119 primOpInfo ReadIVarOp
1121 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1123 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1124 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1125 stateAndPtrPrimTyCon [s, elt]
1127 primOpInfo WriteIVarOp
1129 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1131 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1132 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1137 %************************************************************************
1139 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1141 %************************************************************************
1147 s = alphaTy; s_tv = alphaTyVar
1149 PrimResult SLIT("delay#") [s_tv]
1150 [intPrimTy, mkStatePrimTy s]
1151 statePrimTyCon VoidRep [s]
1153 primOpInfo WaitReadOp
1155 s = alphaTy; s_tv = alphaTyVar
1157 PrimResult SLIT("waitRead#") [s_tv]
1158 [intPrimTy, mkStatePrimTy s]
1159 statePrimTyCon VoidRep [s]
1161 primOpInfo WaitWriteOp
1163 s = alphaTy; s_tv = alphaTyVar
1165 PrimResult SLIT("waitWrite#") [s_tv]
1166 [intPrimTy, mkStatePrimTy s]
1167 statePrimTyCon VoidRep [s]
1170 %************************************************************************
1172 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1174 %************************************************************************
1176 Not everything should/can be in the Haskell heap. As an example, in an
1177 image processing application written in Haskell, you really would like
1178 to avoid heaving huge images between different space or generations of
1179 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1180 which refer to some externally allocated structure/value. Using @ForeignObj@,
1181 just a reference to an image is present in the heap, the image could then
1182 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1183 a completely separate address space alltogether.
1185 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1186 associated with the object is invoked (currently, each ForeignObj has a
1187 direct reference to its finaliser). -- SOF
1189 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1192 makeForeignObj# :: Addr# -- foreign object
1193 -> Addr# -- ptr to its finaliser routine
1194 -> StateAndForeignObj# _RealWorld# ForeignObj#
1199 primOpInfo MakeForeignObjOp
1200 = AlgResult SLIT("makeForeignObj#") []
1201 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1202 stateAndForeignObjPrimTyCon [realWorldTy]
1206 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1207 the external object wrapped up inside a @ForeignObj@. This primitive is used
1208 when a mixed programming interface of implicit and explicit de-allocation is used,
1209 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1210 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1211 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1212 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1213 We deal with this situation, by allowing the programmer to destructively modify
1214 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1215 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1218 writeForeignObj# :: ForeignObj# -- foreign object
1219 -> Addr# -- new data value
1220 -> StateAndForeignObj# _RealWorld# ForeignObj#
1224 primOpInfo WriteForeignObjOp
1226 s = alphaTy; s_tv = alphaTyVar
1228 PrimResult SLIT("writeForeignObj#") [s_tv]
1229 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1230 statePrimTyCon VoidRep [s]
1233 %************************************************************************
1235 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1237 %************************************************************************
1239 A {\em stable pointer} is an index into a table of pointers into the
1240 heap. Since the garbage collector is told about stable pointers, it
1241 is safe to pass a stable pointer to external systems such as C
1244 Here's what the operations and types are supposed to be (from
1245 state-interface document).
1248 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1249 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1250 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1253 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1254 operation since it doesn't (directly) involve IO operations. The
1255 reason is that if some optimisation pass decided to duplicate calls to
1256 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1257 massive space leak can result. Putting it into the PrimIO monad
1258 prevents this. (Another reason for putting them in a monad is to
1259 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1262 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1263 besides, it's not likely to be used from Haskell) so it's not a
1266 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1269 primOpInfo MakeStablePtrOp
1270 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1271 [alphaTy, realWorldStatePrimTy]
1272 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1274 primOpInfo DeRefStablePtrOp
1275 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1276 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1277 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1280 %************************************************************************
1282 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1284 %************************************************************************
1286 [Alastair Reid is to blame for this!]
1288 These days, (Glasgow) Haskell seems to have a bit of everything from
1289 other languages: strict operations, mutable variables, sequencing,
1290 pointers, etc. About the only thing left is LISP's ability to test
1291 for pointer equality. So, let's add it in!
1294 reallyUnsafePtrEquality :: a -> a -> Int#
1297 which tests any two closures (of the same type) to see if they're the
1298 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1299 difficulties of trying to box up the result.)
1301 NB This is {\em really unsafe\/} because even something as trivial as
1302 a garbage collection might change the answer by removing indirections.
1303 Still, no-one's forcing you to use it. If you're worried about little
1304 things like loss of referential transparency, you might like to wrap
1305 it all up in a monad-like thing as John O'Donnell and John Hughes did
1306 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1309 I'm thinking of using it to speed up a critical equality test in some
1310 graphics stuff in a context where the possibility of saying that
1311 denotationally equal things aren't isn't a problem (as long as it
1312 doesn't happen too often.) ADR
1314 To Will: Jim said this was already in, but I can't see it so I'm
1315 adding it. Up to you whether you add it. (Note that this could have
1316 been readily implemented using a @veryDangerousCCall@ before they were
1320 primOpInfo ReallyUnsafePtrEqualityOp
1321 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1322 [alphaTy, alphaTy] intPrimTyCon IntRep []
1325 %************************************************************************
1327 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1329 %************************************************************************
1332 primOpInfo SeqOp -- seq# :: a -> Int#
1333 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1335 primOpInfo ParOp -- par# :: a -> Int#
1336 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1338 primOpInfo ForkOp -- fork# :: a -> Int#
1339 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1344 -- HWL: The first 4 Int# in all par... annotations denote:
1345 -- name, granularity info, size of result, degree of parallelism
1346 -- Same structure as _seq_ i.e. returns Int#
1348 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1349 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1351 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1352 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1354 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1355 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1357 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1358 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1360 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1361 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1363 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1364 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1366 primOpInfo CopyableOp -- copyable# :: a -> a
1367 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1369 primOpInfo NoFollowOp -- noFollow# :: a -> a
1370 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1373 %************************************************************************
1375 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1377 %************************************************************************
1380 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1381 = PrimResult SLIT("errorIO#") []
1382 [primio_ish_ty unitTy]
1383 statePrimTyCon VoidRep [realWorldTy]
1385 primio_ish_ty result
1386 = mkFunTy (mkStatePrimTy realWorldTy) (mkSTretTy realWorldTy result)
1389 %************************************************************************
1391 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1393 %************************************************************************
1396 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1397 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1399 (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
1402 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1406 %************************************************************************
1408 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1410 %************************************************************************
1412 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1413 with @Integers@ can trigger GC. Here we describe the heap requirements
1414 of the various @PrimOps@. For most, no heap is required. For a few,
1415 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1416 be combined with the rest of the heap usage in the basic block. For an
1417 unfortunate few, some unknown amount of heap is required (these are the
1418 ops which can trigger GC).
1421 data HeapRequirement
1423 | FixedHeapRequired HeapOffset
1424 | VariableHeapRequired
1426 primOpHeapReq :: PrimOp -> HeapRequirement
1428 primOpHeapReq NewArrayOp = VariableHeapRequired
1429 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1431 primOpHeapReq IntegerAddOp = VariableHeapRequired
1432 primOpHeapReq IntegerSubOp = VariableHeapRequired
1433 primOpHeapReq IntegerMulOp = VariableHeapRequired
1434 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1435 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1436 primOpHeapReq IntegerNegOp = VariableHeapRequired
1437 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1438 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1439 (intOff mIN_MP_INT_SIZE))
1440 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1441 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1442 (intOff mIN_MP_INT_SIZE))
1443 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1444 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1445 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1446 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1447 (intOff mIN_MP_INT_SIZE)))
1448 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1449 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1450 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1451 (intOff mIN_MP_INT_SIZE)))
1454 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1455 or if it returns a ForeignObj.
1457 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1458 why dod we need to be so indeterminate about it? --SOF
1460 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1461 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1463 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1464 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1466 -- this occasionally has to expand the Stable Pointer table
1467 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1469 -- These four only need heap space with the native code generator
1470 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1472 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1473 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1474 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1475 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1477 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1478 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1479 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1481 -- Sparking ops no longer allocate any heap; however, _fork_ may
1482 -- require a context switch to clear space in the required thread
1483 -- pool, and that requires liveness information.
1485 primOpHeapReq ParOp = NoHeapRequired
1486 primOpHeapReq ForkOp = VariableHeapRequired
1488 -- A SeqOp requires unknown space to evaluate its argument
1489 primOpHeapReq SeqOp = VariableHeapRequired
1491 -- GranSim sparks are stgMalloced i.e. no heap required
1492 primOpHeapReq ParGlobalOp = NoHeapRequired
1493 primOpHeapReq ParLocalOp = NoHeapRequired
1494 primOpHeapReq ParAtOp = NoHeapRequired
1495 primOpHeapReq ParAtAbsOp = NoHeapRequired
1496 primOpHeapReq ParAtRelOp = NoHeapRequired
1497 primOpHeapReq ParAtForNowOp = NoHeapRequired
1498 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1499 primOpHeapReq CopyableOp = NoHeapRequired
1500 primOpHeapReq NoFollowOp = NoHeapRequired
1502 primOpHeapReq other_op = NoHeapRequired
1505 The amount of stack required by primops.
1508 data StackRequirement
1510 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1511 | VariableStackRequired
1513 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1514 primOpStackRequired _ = VariableStackRequired
1515 -- ToDo: be more specific for certain primops (currently only used for seq)
1518 Primops which can trigger GC have to be called carefully.
1519 In particular, their arguments are guaranteed to be in registers,
1520 and a liveness mask tells which regs are live.
1523 primOpCanTriggerGC op
1531 case primOpHeapReq op of
1532 VariableHeapRequired -> True
1536 Sometimes we may choose to execute a PrimOp even though it isn't
1537 certain that its result will be required; ie execute them
1538 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1539 this is OK, because PrimOps are usually cheap, but it isn't OK for
1540 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1542 See also @primOpIsCheap@ (below).
1544 There should be no worries about side effects; that's all taken care
1545 of by data dependencies.
1548 primOpOkForSpeculation :: PrimOp -> Bool
1551 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1552 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1555 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1556 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1558 -- Float. ToDo: tan? tanh?
1559 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1560 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1561 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1562 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1564 -- Double. ToDo: tan? tanh?
1565 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1566 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1567 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1568 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1571 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1574 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1577 primOpOkForSpeculation ParOp = False -- Could be expensive!
1578 primOpOkForSpeculation ForkOp = False -- Likewise
1579 primOpOkForSpeculation SeqOp = False -- Likewise
1581 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1582 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1583 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1584 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1585 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1586 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1587 primOpOkForSpeculation CopyableOp = False -- only tags closure
1588 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1590 -- The default is "yes it's ok for speculation"
1591 primOpOkForSpeculation other_op = True
1594 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1595 WARNING), we just borrow some other predicates for a
1596 what-should-be-good-enough test.
1599 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1602 And some primops have side-effects and so, for example, must not be
1606 fragilePrimOp :: PrimOp -> Bool
1608 fragilePrimOp ParOp = True
1609 fragilePrimOp ForkOp = True
1610 fragilePrimOp SeqOp = True
1611 fragilePrimOp MakeForeignObjOp = True -- SOF
1612 fragilePrimOp WriteForeignObjOp = True -- SOF
1613 fragilePrimOp MakeStablePtrOp = True
1614 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1616 fragilePrimOp ParGlobalOp = True
1617 fragilePrimOp ParLocalOp = True
1618 fragilePrimOp ParAtOp = True
1619 fragilePrimOp ParAtAbsOp = True
1620 fragilePrimOp ParAtRelOp = True
1621 fragilePrimOp ParAtForNowOp = True
1622 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1623 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1625 fragilePrimOp other = False
1628 Primitive operations that perform calls need wrappers to save any live variables
1629 that are stored in caller-saves registers
1632 primOpNeedsWrapper :: PrimOp -> Bool
1634 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1636 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1637 primOpNeedsWrapper (NewByteArrayOp _) = True
1639 primOpNeedsWrapper IntegerAddOp = True
1640 primOpNeedsWrapper IntegerSubOp = True
1641 primOpNeedsWrapper IntegerMulOp = True
1642 primOpNeedsWrapper IntegerQuotRemOp = True
1643 primOpNeedsWrapper IntegerDivModOp = True
1644 primOpNeedsWrapper IntegerNegOp = True
1645 primOpNeedsWrapper IntegerCmpOp = True
1646 primOpNeedsWrapper Integer2IntOp = True
1647 primOpNeedsWrapper Int2IntegerOp = True
1648 primOpNeedsWrapper Word2IntegerOp = True
1649 primOpNeedsWrapper Addr2IntegerOp = True
1651 primOpNeedsWrapper FloatExpOp = True
1652 primOpNeedsWrapper FloatLogOp = True
1653 primOpNeedsWrapper FloatSqrtOp = True
1654 primOpNeedsWrapper FloatSinOp = True
1655 primOpNeedsWrapper FloatCosOp = True
1656 primOpNeedsWrapper FloatTanOp = True
1657 primOpNeedsWrapper FloatAsinOp = True
1658 primOpNeedsWrapper FloatAcosOp = True
1659 primOpNeedsWrapper FloatAtanOp = True
1660 primOpNeedsWrapper FloatSinhOp = True
1661 primOpNeedsWrapper FloatCoshOp = True
1662 primOpNeedsWrapper FloatTanhOp = True
1663 primOpNeedsWrapper FloatPowerOp = True
1664 primOpNeedsWrapper FloatEncodeOp = True
1665 primOpNeedsWrapper FloatDecodeOp = True
1667 primOpNeedsWrapper DoubleExpOp = True
1668 primOpNeedsWrapper DoubleLogOp = True
1669 primOpNeedsWrapper DoubleSqrtOp = True
1670 primOpNeedsWrapper DoubleSinOp = True
1671 primOpNeedsWrapper DoubleCosOp = True
1672 primOpNeedsWrapper DoubleTanOp = True
1673 primOpNeedsWrapper DoubleAsinOp = True
1674 primOpNeedsWrapper DoubleAcosOp = True
1675 primOpNeedsWrapper DoubleAtanOp = True
1676 primOpNeedsWrapper DoubleSinhOp = True
1677 primOpNeedsWrapper DoubleCoshOp = True
1678 primOpNeedsWrapper DoubleTanhOp = True
1679 primOpNeedsWrapper DoublePowerOp = True
1680 primOpNeedsWrapper DoubleEncodeOp = True
1681 primOpNeedsWrapper DoubleDecodeOp = True
1683 primOpNeedsWrapper MakeForeignObjOp = True
1684 primOpNeedsWrapper WriteForeignObjOp = True
1685 primOpNeedsWrapper MakeStablePtrOp = True
1686 primOpNeedsWrapper DeRefStablePtrOp = True
1688 primOpNeedsWrapper TakeMVarOp = True
1689 primOpNeedsWrapper PutMVarOp = True
1690 primOpNeedsWrapper ReadIVarOp = True
1692 primOpNeedsWrapper DelayOp = True
1693 primOpNeedsWrapper WaitReadOp = True
1694 primOpNeedsWrapper WaitWriteOp = True
1696 primOpNeedsWrapper other_op = False
1701 = case (primOpInfo op) of
1703 Monadic str _ -> str
1704 Compare str _ -> str
1705 Coercing str _ _ -> str
1706 PrimResult str _ _ _ _ _ -> str
1707 AlgResult str _ _ _ _ -> str
1710 @primOpType@ duplicates some work of @primOpId@, but since we
1711 grab types pretty often...
1713 primOpType :: PrimOp -> Type
1716 = case (primOpInfo op) of
1717 Dyadic str ty -> dyadic_fun_ty ty
1718 Monadic str ty -> monadic_fun_ty ty
1719 Compare str ty -> compare_fun_ty ty
1720 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1722 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1723 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1725 AlgResult str tyvars arg_tys tycon res_tys ->
1726 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1730 data PrimOpResultInfo
1731 = ReturnsPrim PrimRep
1734 -- ToDo: Deal with specialised PrimOps
1735 -- Will need to return specialised tycon and data constructors
1737 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1739 getPrimOpResultInfo op
1740 = case (primOpInfo op) of
1741 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1742 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1743 Compare _ ty -> ReturnsAlg boolTyCon
1744 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1745 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1746 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1748 isCompareOp :: PrimOp -> Bool
1751 = case primOpInfo op of
1756 The commutable ops are those for which we will try to move constants
1757 to the right hand side for strength reduction.
1760 commutableOp :: PrimOp -> Bool
1762 commutableOp CharEqOp = True
1763 commutableOp CharNeOp = True
1764 commutableOp IntAddOp = True
1765 commutableOp IntMulOp = True
1766 commutableOp AndOp = True
1767 commutableOp OrOp = True
1768 commutableOp IntEqOp = True
1769 commutableOp IntNeOp = True
1770 commutableOp IntegerAddOp = True
1771 commutableOp IntegerMulOp = True
1772 commutableOp FloatAddOp = True
1773 commutableOp FloatMulOp = True
1774 commutableOp FloatEqOp = True
1775 commutableOp FloatNeOp = True
1776 commutableOp DoubleAddOp = True
1777 commutableOp DoubleMulOp = True
1778 commutableOp DoubleEqOp = True
1779 commutableOp DoubleNeOp = True
1780 commutableOp _ = False
1785 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1786 monadic_fun_ty ty = mkFunTy ty ty
1787 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1792 pprPrimOp :: PprStyle -> PrimOp -> Doc
1793 showPrimOp :: PprStyle -> PrimOp -> String
1795 showPrimOp sty op = render (pprPrimOp sty op)
1797 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1801 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1803 if may_gc then "_ccall_GC_ " else "_ccall_ "
1806 = if is_casm then text "''" else empty
1809 = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
1811 hcat [text before, ptext fun, after, space, brackets pp_tys]
1813 pprPrimOp sty other_op
1814 | codeStyle sty -- For C just print the primop itself
1817 | ifaceStyle sty -- For interfaces Print it qualified with GHC.
1818 = ptext SLIT("GHC.") <> ptext str
1820 | otherwise -- Unqualified is good enough
1823 str = primOp_str other_op
1827 instance Outputable PrimOp where
1828 ppr sty op = pprPrimOp sty op