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 CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
40 import HeapOffs ( addOff, intOff, totHdrSize )
41 import PprStyle ( codeStyle, PprStyle(..){-ToDo:rm-} )
42 import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
44 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
45 import TyCon ( TyCon{-instances-} )
46 import Type ( getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts,
47 mkForAllTys, mkFunTys, applyTyCon, typePrimRep
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.
151 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
153 | NewSynchVarOp -- for MVars and IVars
154 | TakeMVarOp | PutMVarOp
155 | ReadIVarOp | WriteIVarOp
157 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
158 | MakeStablePtrOp | DeRefStablePtrOp
161 A special ``trap-door'' to use in making calls direct to C functions:
163 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
164 Bool -- True <=> really a "casm"
165 Bool -- True <=> might invoke Haskell GC
166 [Type] -- Unboxed argument; the state-token
167 -- argument will have been put *first*
168 Type -- Return type; one of the "StateAnd<blah>#" types
170 -- (... to be continued ... )
173 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
174 (See @primOpInfo@ for details.)
176 Note: that first arg and part of the result should be the system state
177 token (which we carry around to fool over-zealous optimisers) but
178 which isn't actually passed.
180 For example, we represent
182 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
188 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
189 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
193 (AlgAlts [ ( FloatPrimAndIoWorld,
195 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
201 Nota Bene: there are some people who find the empty list of types in
202 the @Prim@ somewhat puzzling and would represent the above by
206 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
207 -- :: /\ alpha1, alpha2 alpha3, alpha4.
208 -- alpha1 -> alpha2 -> alpha3 -> alpha4
209 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
212 (AlgAlts [ ( FloatPrimAndIoWorld,
214 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
220 But, this is a completely different way of using @CCallOp@. The most
221 major changes required if we switch to this are in @primOpInfo@, and
222 the desugarer. The major difficulty is in moving the HeapRequirement
223 stuff somewhere appropriate. (The advantage is that we could simplify
224 @CCallOp@ and record just the number of arguments with corresponding
225 simplifications in reading pragma unfoldings, the simplifier,
226 instantiation (etc) of core expressions, ... . Maybe we should think
227 about using it this way?? ADR)
230 -- (... continued from above ... )
232 -- one to support "errorIO" (and, thereby, "error")
235 -- Operation to test two closure addresses for equality (yes really!)
236 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
237 | ReallyUnsafePtrEqualityOp
239 -- three for parallel stuff
244 -- three for concurrency
249 | ParGlobalOp -- named global par
250 | ParLocalOp -- named local par
251 | ParAtOp -- specifies destination of local par
252 | ParAtAbsOp -- specifies destination of local par (abs processor)
253 | ParAtRelOp -- specifies destination of local par (rel processor)
254 | ParAtForNowOp -- specifies initial destination of global par
255 | CopyableOp -- marks copyable code
256 | NoFollowOp -- marks non-followup expression
259 Deriving Ix is what we really want! ToDo
260 (Chk around before deleting...)
262 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
263 tagOf_PrimOp CharGeOp = ILIT( 2)
264 tagOf_PrimOp CharEqOp = ILIT( 3)
265 tagOf_PrimOp CharNeOp = ILIT( 4)
266 tagOf_PrimOp CharLtOp = ILIT( 5)
267 tagOf_PrimOp CharLeOp = ILIT( 6)
268 tagOf_PrimOp IntGtOp = ILIT( 7)
269 tagOf_PrimOp IntGeOp = ILIT( 8)
270 tagOf_PrimOp IntEqOp = ILIT( 9)
271 tagOf_PrimOp IntNeOp = ILIT( 10)
272 tagOf_PrimOp IntLtOp = ILIT( 11)
273 tagOf_PrimOp IntLeOp = ILIT( 12)
274 tagOf_PrimOp WordGtOp = ILIT( 13)
275 tagOf_PrimOp WordGeOp = ILIT( 14)
276 tagOf_PrimOp WordEqOp = ILIT( 15)
277 tagOf_PrimOp WordNeOp = ILIT( 16)
278 tagOf_PrimOp WordLtOp = ILIT( 17)
279 tagOf_PrimOp WordLeOp = ILIT( 18)
280 tagOf_PrimOp AddrGtOp = ILIT( 19)
281 tagOf_PrimOp AddrGeOp = ILIT( 20)
282 tagOf_PrimOp AddrEqOp = ILIT( 21)
283 tagOf_PrimOp AddrNeOp = ILIT( 22)
284 tagOf_PrimOp AddrLtOp = ILIT( 23)
285 tagOf_PrimOp AddrLeOp = ILIT( 24)
286 tagOf_PrimOp FloatGtOp = ILIT( 25)
287 tagOf_PrimOp FloatGeOp = ILIT( 26)
288 tagOf_PrimOp FloatEqOp = ILIT( 27)
289 tagOf_PrimOp FloatNeOp = ILIT( 28)
290 tagOf_PrimOp FloatLtOp = ILIT( 29)
291 tagOf_PrimOp FloatLeOp = ILIT( 30)
292 tagOf_PrimOp DoubleGtOp = ILIT( 31)
293 tagOf_PrimOp DoubleGeOp = ILIT( 32)
294 tagOf_PrimOp DoubleEqOp = ILIT( 33)
295 tagOf_PrimOp DoubleNeOp = ILIT( 34)
296 tagOf_PrimOp DoubleLtOp = ILIT( 35)
297 tagOf_PrimOp DoubleLeOp = ILIT( 36)
298 tagOf_PrimOp OrdOp = ILIT( 37)
299 tagOf_PrimOp ChrOp = ILIT( 38)
300 tagOf_PrimOp IntAddOp = ILIT( 39)
301 tagOf_PrimOp IntSubOp = ILIT( 40)
302 tagOf_PrimOp IntMulOp = ILIT( 41)
303 tagOf_PrimOp IntQuotOp = ILIT( 42)
304 tagOf_PrimOp IntRemOp = ILIT( 44)
305 tagOf_PrimOp IntNegOp = ILIT( 45)
306 tagOf_PrimOp IntAbsOp = ILIT( 46)
307 tagOf_PrimOp AndOp = ILIT( 47)
308 tagOf_PrimOp OrOp = ILIT( 48)
309 tagOf_PrimOp NotOp = ILIT( 49)
310 tagOf_PrimOp SllOp = ILIT( 50)
311 tagOf_PrimOp SraOp = ILIT( 51)
312 tagOf_PrimOp SrlOp = ILIT( 52)
313 tagOf_PrimOp ISllOp = ILIT( 53)
314 tagOf_PrimOp ISraOp = ILIT( 54)
315 tagOf_PrimOp ISrlOp = ILIT( 55)
316 tagOf_PrimOp Int2WordOp = ILIT( 56)
317 tagOf_PrimOp Word2IntOp = ILIT( 57)
318 tagOf_PrimOp Int2AddrOp = ILIT( 58)
319 tagOf_PrimOp Addr2IntOp = ILIT( 59)
320 tagOf_PrimOp FloatAddOp = ILIT( 60)
321 tagOf_PrimOp FloatSubOp = ILIT( 61)
322 tagOf_PrimOp FloatMulOp = ILIT( 62)
323 tagOf_PrimOp FloatDivOp = ILIT( 63)
324 tagOf_PrimOp FloatNegOp = ILIT( 64)
325 tagOf_PrimOp Float2IntOp = ILIT( 65)
326 tagOf_PrimOp Int2FloatOp = ILIT( 66)
327 tagOf_PrimOp FloatExpOp = ILIT( 67)
328 tagOf_PrimOp FloatLogOp = ILIT( 68)
329 tagOf_PrimOp FloatSqrtOp = ILIT( 69)
330 tagOf_PrimOp FloatSinOp = ILIT( 70)
331 tagOf_PrimOp FloatCosOp = ILIT( 71)
332 tagOf_PrimOp FloatTanOp = ILIT( 72)
333 tagOf_PrimOp FloatAsinOp = ILIT( 73)
334 tagOf_PrimOp FloatAcosOp = ILIT( 74)
335 tagOf_PrimOp FloatAtanOp = ILIT( 75)
336 tagOf_PrimOp FloatSinhOp = ILIT( 76)
337 tagOf_PrimOp FloatCoshOp = ILIT( 77)
338 tagOf_PrimOp FloatTanhOp = ILIT( 78)
339 tagOf_PrimOp FloatPowerOp = ILIT( 79)
340 tagOf_PrimOp DoubleAddOp = ILIT( 80)
341 tagOf_PrimOp DoubleSubOp = ILIT( 81)
342 tagOf_PrimOp DoubleMulOp = ILIT( 82)
343 tagOf_PrimOp DoubleDivOp = ILIT( 83)
344 tagOf_PrimOp DoubleNegOp = ILIT( 84)
345 tagOf_PrimOp Double2IntOp = ILIT( 85)
346 tagOf_PrimOp Int2DoubleOp = ILIT( 86)
347 tagOf_PrimOp Double2FloatOp = ILIT( 87)
348 tagOf_PrimOp Float2DoubleOp = ILIT( 88)
349 tagOf_PrimOp DoubleExpOp = ILIT( 89)
350 tagOf_PrimOp DoubleLogOp = ILIT( 90)
351 tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
352 tagOf_PrimOp DoubleSinOp = ILIT( 92)
353 tagOf_PrimOp DoubleCosOp = ILIT( 93)
354 tagOf_PrimOp DoubleTanOp = ILIT( 94)
355 tagOf_PrimOp DoubleAsinOp = ILIT( 95)
356 tagOf_PrimOp DoubleAcosOp = ILIT( 96)
357 tagOf_PrimOp DoubleAtanOp = ILIT( 97)
358 tagOf_PrimOp DoubleSinhOp = ILIT( 98)
359 tagOf_PrimOp DoubleCoshOp = ILIT( 99)
360 tagOf_PrimOp DoubleTanhOp = ILIT(100)
361 tagOf_PrimOp DoublePowerOp = ILIT(101)
362 tagOf_PrimOp IntegerAddOp = ILIT(102)
363 tagOf_PrimOp IntegerSubOp = ILIT(103)
364 tagOf_PrimOp IntegerMulOp = ILIT(104)
365 tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
366 tagOf_PrimOp IntegerDivModOp = ILIT(106)
367 tagOf_PrimOp IntegerNegOp = ILIT(107)
368 tagOf_PrimOp IntegerCmpOp = ILIT(108)
369 tagOf_PrimOp Integer2IntOp = ILIT(109)
370 tagOf_PrimOp Int2IntegerOp = ILIT(110)
371 tagOf_PrimOp Word2IntegerOp = ILIT(111)
372 tagOf_PrimOp Addr2IntegerOp = ILIT(112)
373 tagOf_PrimOp FloatEncodeOp = ILIT(113)
374 tagOf_PrimOp FloatDecodeOp = ILIT(114)
375 tagOf_PrimOp DoubleEncodeOp = ILIT(115)
376 tagOf_PrimOp DoubleDecodeOp = ILIT(116)
377 tagOf_PrimOp NewArrayOp = ILIT(117)
378 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
379 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
380 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
381 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
382 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
383 tagOf_PrimOp SameMutableArrayOp = ILIT(123)
384 tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
385 tagOf_PrimOp ReadArrayOp = ILIT(125)
386 tagOf_PrimOp WriteArrayOp = ILIT(126)
387 tagOf_PrimOp IndexArrayOp = ILIT(127)
388 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
389 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
390 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
391 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
392 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
393 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
394 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
395 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
396 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
397 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
398 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
399 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
400 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
401 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
402 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
403 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
404 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
405 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
406 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
407 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
408 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
409 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
410 tagOf_PrimOp NewSynchVarOp = ILIT(150)
411 tagOf_PrimOp TakeMVarOp = ILIT(151)
412 tagOf_PrimOp PutMVarOp = ILIT(152)
413 tagOf_PrimOp ReadIVarOp = ILIT(153)
414 tagOf_PrimOp WriteIVarOp = ILIT(154)
415 tagOf_PrimOp MakeForeignObjOp = ILIT(155)
416 tagOf_PrimOp MakeStablePtrOp = ILIT(156)
417 tagOf_PrimOp DeRefStablePtrOp = ILIT(157)
418 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(158)
419 tagOf_PrimOp ErrorIOPrimOp = ILIT(159)
420 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(160)
421 tagOf_PrimOp SeqOp = ILIT(161)
422 tagOf_PrimOp ParOp = ILIT(162)
423 tagOf_PrimOp ForkOp = ILIT(163)
424 tagOf_PrimOp DelayOp = ILIT(164)
425 tagOf_PrimOp WaitReadOp = ILIT(165)
426 tagOf_PrimOp WaitWriteOp = ILIT(166)
428 tagOf_PrimOp ParGlobalOp = ILIT(167)
429 tagOf_PrimOp ParLocalOp = ILIT(168)
430 tagOf_PrimOp ParAtOp = ILIT(169)
431 tagOf_PrimOp ParAtAbsOp = ILIT(170)
432 tagOf_PrimOp ParAtRelOp = ILIT(171)
433 tagOf_PrimOp ParAtForNowOp = ILIT(172)
434 tagOf_PrimOp CopyableOp = ILIT(173)
435 tagOf_PrimOp NoFollowOp = ILIT(174)
437 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
439 instance Eq PrimOp where
440 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
443 An @Enum@-derived list would be better; meanwhile... (ToDo)
561 NewByteArrayOp CharRep,
562 NewByteArrayOp IntRep,
563 NewByteArrayOp AddrRep,
564 NewByteArrayOp FloatRep,
565 NewByteArrayOp DoubleRep,
567 SameMutableByteArrayOp,
571 ReadByteArrayOp CharRep,
572 ReadByteArrayOp IntRep,
573 ReadByteArrayOp AddrRep,
574 ReadByteArrayOp FloatRep,
575 ReadByteArrayOp DoubleRep,
576 WriteByteArrayOp CharRep,
577 WriteByteArrayOp IntRep,
578 WriteByteArrayOp AddrRep,
579 WriteByteArrayOp FloatRep,
580 WriteByteArrayOp DoubleRep,
581 IndexByteArrayOp CharRep,
582 IndexByteArrayOp IntRep,
583 IndexByteArrayOp AddrRep,
584 IndexByteArrayOp FloatRep,
585 IndexByteArrayOp DoubleRep,
586 IndexOffAddrOp CharRep,
587 IndexOffAddrOp IntRep,
588 IndexOffAddrOp AddrRep,
589 IndexOffAddrOp FloatRep,
590 IndexOffAddrOp DoubleRep,
592 UnsafeFreezeByteArrayOp,
602 ReallyUnsafePtrEqualityOp,
621 %************************************************************************
623 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
625 %************************************************************************
627 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
628 refer to the primitive operation. The conventional \tr{#}-for-
629 unboxed ops is added on later.
631 The reason for the funny characters in the names is so we do not
632 interfere with the programmer's Haskell name spaces.
634 We use @PrimKinds@ for the ``type'' information, because they're
635 (slightly) more convenient to use than @TyCons@.
638 = Dyadic FAST_STRING -- string :: T -> T -> T
640 | Monadic FAST_STRING -- string :: T -> T
642 | Compare FAST_STRING -- string :: T -> T -> Bool
644 | Coercing FAST_STRING -- string :: T1 -> T2
648 | PrimResult FAST_STRING
649 [TyVar] [Type] TyCon PrimRep [Type]
650 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
651 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
652 -- D# is a primitive type constructor.
653 -- (the kind is the same info as D#, in another convenient form)
655 | AlgResult FAST_STRING
656 [TyVar] [Type] TyCon [Type]
657 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
658 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
660 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
665 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
667 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
668 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
669 an_Integer_and_Int_tys
670 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
673 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
675 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
677 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
679 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
682 @primOpInfo@ gives all essential information (from which everything
683 else, notably a type, can be constructed) for each @PrimOp@.
686 primOpInfo :: PrimOp -> PrimOpInfo
689 There's plenty of this stuff!
691 %************************************************************************
693 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
695 %************************************************************************
698 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
699 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
700 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
701 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
702 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
703 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
705 primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
706 primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
707 primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
708 primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
709 primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
710 primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
712 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
713 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
714 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
715 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
716 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
717 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
719 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
720 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
721 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
722 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
723 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
724 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
726 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
727 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
728 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
729 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
730 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
731 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
733 primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
734 primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
735 primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
736 primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
737 primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
738 primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
741 %************************************************************************
743 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
745 %************************************************************************
748 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
749 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
752 %************************************************************************
754 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
756 %************************************************************************
759 primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
760 primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
761 primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
762 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
763 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
765 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
768 %************************************************************************
770 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
772 %************************************************************************
774 A @Word#@ is an unsigned @Int#@.
777 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
778 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
779 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
782 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
784 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
786 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
789 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
791 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
793 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
795 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
796 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
799 %************************************************************************
801 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
803 %************************************************************************
806 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
807 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
810 %************************************************************************
812 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
814 %************************************************************************
816 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
820 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
821 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
822 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
823 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
824 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
826 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
827 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
829 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
830 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
831 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
832 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
833 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
834 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
835 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
836 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
837 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
838 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
839 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
840 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
841 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
844 %************************************************************************
846 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
848 %************************************************************************
850 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
854 primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
855 primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
856 primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
857 primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
858 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
860 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
861 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
863 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
864 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
866 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
867 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
868 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
869 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
870 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
871 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
872 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
873 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
874 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
875 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
876 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
877 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
878 primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
881 %************************************************************************
883 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
885 %************************************************************************
888 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
890 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
891 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
892 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
894 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
896 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
897 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
899 primOpInfo Integer2IntOp
900 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
902 primOpInfo Int2IntegerOp
903 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
905 primOpInfo Word2IntegerOp
906 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
908 primOpInfo Addr2IntegerOp
909 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
912 Encoding and decoding of floating-point numbers is sorta
916 primOpInfo FloatEncodeOp
917 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
918 floatPrimTyCon FloatRep []
920 primOpInfo DoubleEncodeOp
921 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
922 doublePrimTyCon DoubleRep []
924 primOpInfo FloatDecodeOp
925 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
927 primOpInfo DoubleDecodeOp
928 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
931 %************************************************************************
933 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
935 %************************************************************************
938 primOpInfo NewArrayOp
940 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
942 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
943 stateAndMutableArrayPrimTyCon [s, elt]
945 primOpInfo (NewByteArrayOp kind)
947 s = alphaTy; s_tv = alphaTyVar
949 (str, _, prim_tycon) = getPrimRepInfo kind
951 op_str = _PK_ ("new" ++ str ++ "Array#")
953 AlgResult op_str [s_tv]
954 [intPrimTy, mkStatePrimTy s]
955 stateAndMutableByteArrayPrimTyCon [s]
957 ---------------------------------------------------------------------------
959 primOpInfo SameMutableArrayOp
961 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
962 mut_arr_ty = mkMutableArrayPrimTy s elt
964 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
967 primOpInfo SameMutableByteArrayOp
969 s = alphaTy; s_tv = alphaTyVar;
970 mut_arr_ty = mkMutableByteArrayPrimTy s
972 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
975 ---------------------------------------------------------------------------
976 -- Primitive arrays of Haskell pointers:
978 primOpInfo ReadArrayOp
980 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
982 AlgResult SLIT("readArray#") [s_tv, elt_tv]
983 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
984 stateAndPtrPrimTyCon [s, elt]
987 primOpInfo WriteArrayOp
989 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
991 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
992 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
993 statePrimTyCon VoidRep [s]
995 primOpInfo IndexArrayOp
996 = let { elt = alphaTy; elt_tv = alphaTyVar } in
997 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1000 ---------------------------------------------------------------------------
1001 -- Primitive arrays full of unboxed bytes:
1003 primOpInfo (ReadByteArrayOp kind)
1005 s = alphaTy; s_tv = alphaTyVar
1007 (str, _, prim_tycon) = getPrimRepInfo kind
1009 op_str = _PK_ ("read" ++ str ++ "Array#")
1010 relevant_tycon = assoc "primOpInfo" tbl kind
1012 AlgResult op_str [s_tv]
1013 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1016 tbl = [ (CharRep, stateAndCharPrimTyCon),
1017 (IntRep, stateAndIntPrimTyCon),
1018 (AddrRep, stateAndAddrPrimTyCon),
1019 (FloatRep, stateAndFloatPrimTyCon),
1020 (DoubleRep, stateAndDoublePrimTyCon) ]
1022 -- How come there's no Word byte arrays? ADR
1024 primOpInfo (WriteByteArrayOp kind)
1026 s = alphaTy; s_tv = alphaTyVar
1028 (str, prim_ty, _) = getPrimRepInfo kind
1029 op_str = _PK_ ("write" ++ str ++ "Array#")
1031 -- NB: *Prim*Result --
1032 PrimResult op_str [s_tv]
1033 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1034 statePrimTyCon VoidRep [s]
1036 primOpInfo (IndexByteArrayOp kind)
1038 (str, _, prim_tycon) = getPrimRepInfo kind
1039 op_str = _PK_ ("index" ++ str ++ "Array#")
1041 -- NB: *Prim*Result --
1042 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1044 primOpInfo (IndexOffAddrOp kind)
1046 (str, _, prim_tycon) = getPrimRepInfo kind
1047 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1049 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1051 ---------------------------------------------------------------------------
1052 primOpInfo UnsafeFreezeArrayOp
1054 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1056 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1057 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1058 stateAndArrayPrimTyCon [s, elt]
1060 primOpInfo UnsafeFreezeByteArrayOp
1061 = let { s = alphaTy; s_tv = alphaTyVar } in
1062 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1063 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1064 stateAndByteArrayPrimTyCon [s]
1067 %************************************************************************
1069 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1071 %************************************************************************
1074 primOpInfo NewSynchVarOp
1076 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1078 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1079 stateAndSynchVarPrimTyCon [s, elt]
1081 primOpInfo TakeMVarOp
1083 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1085 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1086 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1087 stateAndPtrPrimTyCon [s, elt]
1089 primOpInfo PutMVarOp
1091 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1093 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1094 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1097 primOpInfo ReadIVarOp
1099 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1101 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1102 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1103 stateAndPtrPrimTyCon [s, elt]
1105 primOpInfo WriteIVarOp
1107 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1109 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1110 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1115 %************************************************************************
1117 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1119 %************************************************************************
1125 s = alphaTy; s_tv = alphaTyVar
1127 PrimResult SLIT("delay#") [s_tv]
1128 [intPrimTy, mkStatePrimTy s]
1129 statePrimTyCon VoidRep [s]
1131 primOpInfo WaitReadOp
1133 s = alphaTy; s_tv = alphaTyVar
1135 PrimResult SLIT("waitRead#") [s_tv]
1136 [intPrimTy, mkStatePrimTy s]
1137 statePrimTyCon VoidRep [s]
1139 primOpInfo WaitWriteOp
1141 s = alphaTy; s_tv = alphaTyVar
1143 PrimResult SLIT("waitWrite#") [s_tv]
1144 [intPrimTy, mkStatePrimTy s]
1145 statePrimTyCon VoidRep [s]
1148 %************************************************************************
1150 \subsubsection[PrimOps-makeForeignObj]{PrimOpInfo for Foreign Objects}
1152 %************************************************************************
1154 Not everything should/can be in the Haskell heap. As an example, in an
1155 image processing application written in Haskell, you really would like
1156 to avoid heaving huge images between different space or generations of
1157 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1158 which refer to some externally allocated structure/value. Using @ForeignObj@,
1159 just a reference to an image is present in the heap, the image could then
1160 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1161 a completely separate address space alltogether.
1163 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1164 associated with the object is invoked (currently, each ForeignObj has a
1165 direct reference to its finaliser). -- SOF
1167 The only function defined over @ForeignObj@s is:
1170 makeForeignObj# :: Addr# -- foreign object
1171 -> Addr# -- ptr to its finaliser routine
1172 -> StateAndForeignObj# _RealWorld# ForeignObj#
1176 primOpInfo MakeForeignObjOp
1177 = AlgResult SLIT("makeForeignObj#") []
1178 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1179 stateAndForeignObjPrimTyCon [realWorldTy]
1182 %************************************************************************
1184 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1186 %************************************************************************
1188 A {\em stable pointer} is an index into a table of pointers into the
1189 heap. Since the garbage collector is told about stable pointers, it
1190 is safe to pass a stable pointer to external systems such as C
1193 Here's what the operations and types are supposed to be (from
1194 state-interface document).
1197 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1198 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1199 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1202 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1203 operation since it doesn't (directly) involve IO operations. The
1204 reason is that if some optimisation pass decided to duplicate calls to
1205 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1206 massive space leak can result. Putting it into the PrimIO monad
1207 prevents this. (Another reason for putting them in a monad is to
1208 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1211 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1212 besides, it's not likely to be used from Haskell) so it's not a
1215 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1218 primOpInfo MakeStablePtrOp
1219 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1220 [alphaTy, realWorldStatePrimTy]
1221 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1223 primOpInfo DeRefStablePtrOp
1224 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1225 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1226 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1229 %************************************************************************
1231 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1233 %************************************************************************
1235 [Alastair Reid is to blame for this!]
1237 These days, (Glasgow) Haskell seems to have a bit of everything from
1238 other languages: strict operations, mutable variables, sequencing,
1239 pointers, etc. About the only thing left is LISP's ability to test
1240 for pointer equality. So, let's add it in!
1243 reallyUnsafePtrEquality :: a -> a -> Int#
1246 which tests any two closures (of the same type) to see if they're the
1247 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1248 difficulties of trying to box up the result.)
1250 NB This is {\em really unsafe\/} because even something as trivial as
1251 a garbage collection might change the answer by removing indirections.
1252 Still, no-one's forcing you to use it. If you're worried about little
1253 things like loss of referential transparency, you might like to wrap
1254 it all up in a monad-like thing as John O'Donnell and John Hughes did
1255 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1258 I'm thinking of using it to speed up a critical equality test in some
1259 graphics stuff in a context where the possibility of saying that
1260 denotationally equal things aren't isn't a problem (as long as it
1261 doesn't happen too often.) ADR
1263 To Will: Jim said this was already in, but I can't see it so I'm
1264 adding it. Up to you whether you add it. (Note that this could have
1265 been readily implemented using a @veryDangerousCCall@ before they were
1269 primOpInfo ReallyUnsafePtrEqualityOp
1270 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1271 [alphaTy, alphaTy] intPrimTyCon IntRep []
1274 %************************************************************************
1276 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1278 %************************************************************************
1281 primOpInfo SeqOp -- seq# :: a -> Int#
1282 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1284 primOpInfo ParOp -- par# :: a -> Int#
1285 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1287 primOpInfo ForkOp -- fork# :: a -> Int#
1288 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1293 -- HWL: The first 4 Int# in all par... annotations denote:
1294 -- name, granularity info, size of result, degree of parallelism
1296 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1297 = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
1299 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1300 = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
1302 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1303 = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [alphaTy,betaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] liftTyCon [gammaTy]
1305 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1306 = AlgResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
1308 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1309 = AlgResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] liftTyCon [betaTy]
1311 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1312 = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [alphaTy,betaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] liftTyCon [gammaTy]
1314 primOpInfo CopyableOp -- copyable# :: a -> a
1315 = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1317 primOpInfo NoFollowOp -- noFollow# :: a -> a
1318 = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1321 %************************************************************************
1323 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1325 %************************************************************************
1328 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1329 = PrimResult SLIT("errorIO#") []
1331 statePrimTyCon VoidRep [realWorldTy]
1334 %************************************************************************
1336 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1338 %************************************************************************
1341 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1342 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1344 (result_tycon, tys_applied, _) = -- _trace "PrimOp.getAppDataTyConExpandingDicts" $
1345 getAppDataTyConExpandingDicts result_ty
1348 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1352 %************************************************************************
1354 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1356 %************************************************************************
1358 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1359 with @Integers@ can trigger GC. Here we describe the heap requirements
1360 of the various @PrimOps@. For most, no heap is required. For a few,
1361 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1362 be combined with the rest of the heap usage in the basic block. For an
1363 unfortunate few, some unknown amount of heap is required (these are the
1364 ops which can trigger GC).
1367 data HeapRequirement
1369 | FixedHeapRequired HeapOffset
1370 | VariableHeapRequired
1372 primOpHeapReq :: PrimOp -> HeapRequirement
1374 primOpHeapReq NewArrayOp = VariableHeapRequired
1375 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1377 primOpHeapReq IntegerAddOp = VariableHeapRequired
1378 primOpHeapReq IntegerSubOp = VariableHeapRequired
1379 primOpHeapReq IntegerMulOp = VariableHeapRequired
1380 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1381 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1382 primOpHeapReq IntegerNegOp = VariableHeapRequired
1383 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1384 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1385 (intOff mIN_MP_INT_SIZE))
1386 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1387 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1388 (intOff mIN_MP_INT_SIZE))
1389 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1390 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1391 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1392 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1393 (intOff mIN_MP_INT_SIZE)))
1394 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1395 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1396 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1397 (intOff mIN_MP_INT_SIZE)))
1399 -- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1400 -- or if it returns a ForeignObj.
1402 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1403 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1405 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1407 -- this occasionally has to expand the Stable Pointer table
1408 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1410 -- These four only need heap space with the native code generator
1411 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1413 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1414 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1415 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1416 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1418 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1419 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1420 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1422 -- Sparking ops no longer allocate any heap; however, _fork_ may
1423 -- require a context switch to clear space in the required thread
1424 -- pool, and that requires liveness information.
1426 primOpHeapReq ParOp = NoHeapRequired
1427 primOpHeapReq ForkOp = VariableHeapRequired
1429 -- A SeqOp requires unknown space to evaluate its argument
1430 primOpHeapReq SeqOp = VariableHeapRequired
1432 -- GranSim sparks are stgMalloced i.e. no heap required
1433 primOpHeapReq ParGlobalOp = NoHeapRequired
1434 primOpHeapReq ParLocalOp = NoHeapRequired
1435 primOpHeapReq ParAtOp = NoHeapRequired
1436 primOpHeapReq ParAtAbsOp = NoHeapRequired
1437 primOpHeapReq ParAtRelOp = NoHeapRequired
1438 primOpHeapReq ParAtForNowOp = NoHeapRequired
1439 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1440 primOpHeapReq CopyableOp = NoHeapRequired
1441 primOpHeapReq NoFollowOp = NoHeapRequired
1443 primOpHeapReq other_op = NoHeapRequired
1446 The amount of stack required by primops.
1449 data StackRequirement
1451 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1452 | VariableStackRequired
1454 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1455 primOpStackRequired _ = VariableStackRequired
1456 -- ToDo: be more specific for certain primops (currently only used for seq)
1459 Primops which can trigger GC have to be called carefully.
1460 In particular, their arguments are guaranteed to be in registers,
1461 and a liveness mask tells which regs are live.
1464 primOpCanTriggerGC op
1472 case primOpHeapReq op of
1473 VariableHeapRequired -> True
1477 Sometimes we may choose to execute a PrimOp even though it isn't
1478 certain that its result will be required; ie execute them
1479 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1480 this is OK, because PrimOps are usually cheap, but it isn't OK for
1481 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1483 See also @primOpIsCheap@ (below).
1485 There should be no worries about side effects; that's all taken care
1486 of by data dependencies.
1489 primOpOkForSpeculation :: PrimOp -> Bool
1492 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1493 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1496 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1497 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1499 -- Float. ToDo: tan? tanh?
1500 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1501 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1502 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1503 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1505 -- Double. ToDo: tan? tanh?
1506 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1507 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1508 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1509 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1512 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1515 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1518 primOpOkForSpeculation ParOp = False -- Could be expensive!
1519 primOpOkForSpeculation ForkOp = False -- Likewise
1520 primOpOkForSpeculation SeqOp = False -- Likewise
1522 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1523 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1524 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1525 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1526 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1527 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1528 primOpOkForSpeculation CopyableOp = False -- only tags closure
1529 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1531 -- The default is "yes it's ok for speculation"
1532 primOpOkForSpeculation other_op = True
1535 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1536 WARNING), we just borrow some other predicates for a
1537 what-should-be-good-enough test.
1540 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1543 And some primops have side-effects and so, for example, must not be
1547 fragilePrimOp :: PrimOp -> Bool
1549 fragilePrimOp ParOp = True
1550 fragilePrimOp ForkOp = True
1551 fragilePrimOp SeqOp = True
1552 fragilePrimOp MakeForeignObjOp = True -- SOF
1553 fragilePrimOp MakeStablePtrOp = True
1554 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1556 fragilePrimOp ParGlobalOp = True
1557 fragilePrimOp ParLocalOp = True
1558 fragilePrimOp ParAtOp = True
1559 fragilePrimOp ParAtAbsOp = True
1560 fragilePrimOp ParAtRelOp = True
1561 fragilePrimOp ParAtForNowOp = True
1562 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1563 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1565 fragilePrimOp other = False
1568 Primitive operations that perform calls need wrappers to save any live variables
1569 that are stored in caller-saves registers
1572 primOpNeedsWrapper :: PrimOp -> Bool
1574 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1576 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1577 primOpNeedsWrapper (NewByteArrayOp _) = True
1579 primOpNeedsWrapper IntegerAddOp = True
1580 primOpNeedsWrapper IntegerSubOp = True
1581 primOpNeedsWrapper IntegerMulOp = True
1582 primOpNeedsWrapper IntegerQuotRemOp = True
1583 primOpNeedsWrapper IntegerDivModOp = True
1584 primOpNeedsWrapper IntegerNegOp = True
1585 primOpNeedsWrapper IntegerCmpOp = True
1586 primOpNeedsWrapper Integer2IntOp = True
1587 primOpNeedsWrapper Int2IntegerOp = True
1588 primOpNeedsWrapper Word2IntegerOp = True
1589 primOpNeedsWrapper Addr2IntegerOp = True
1591 primOpNeedsWrapper FloatExpOp = True
1592 primOpNeedsWrapper FloatLogOp = True
1593 primOpNeedsWrapper FloatSqrtOp = True
1594 primOpNeedsWrapper FloatSinOp = True
1595 primOpNeedsWrapper FloatCosOp = True
1596 primOpNeedsWrapper FloatTanOp = True
1597 primOpNeedsWrapper FloatAsinOp = True
1598 primOpNeedsWrapper FloatAcosOp = True
1599 primOpNeedsWrapper FloatAtanOp = True
1600 primOpNeedsWrapper FloatSinhOp = True
1601 primOpNeedsWrapper FloatCoshOp = True
1602 primOpNeedsWrapper FloatTanhOp = True
1603 primOpNeedsWrapper FloatPowerOp = True
1604 primOpNeedsWrapper FloatEncodeOp = True
1605 primOpNeedsWrapper FloatDecodeOp = True
1607 primOpNeedsWrapper DoubleExpOp = True
1608 primOpNeedsWrapper DoubleLogOp = True
1609 primOpNeedsWrapper DoubleSqrtOp = True
1610 primOpNeedsWrapper DoubleSinOp = True
1611 primOpNeedsWrapper DoubleCosOp = True
1612 primOpNeedsWrapper DoubleTanOp = True
1613 primOpNeedsWrapper DoubleAsinOp = True
1614 primOpNeedsWrapper DoubleAcosOp = True
1615 primOpNeedsWrapper DoubleAtanOp = True
1616 primOpNeedsWrapper DoubleSinhOp = True
1617 primOpNeedsWrapper DoubleCoshOp = True
1618 primOpNeedsWrapper DoubleTanhOp = True
1619 primOpNeedsWrapper DoublePowerOp = True
1620 primOpNeedsWrapper DoubleEncodeOp = True
1621 primOpNeedsWrapper DoubleDecodeOp = True
1623 primOpNeedsWrapper MakeForeignObjOp = True
1624 primOpNeedsWrapper MakeStablePtrOp = True
1625 primOpNeedsWrapper DeRefStablePtrOp = True
1627 primOpNeedsWrapper TakeMVarOp = True
1628 primOpNeedsWrapper PutMVarOp = True
1629 primOpNeedsWrapper ReadIVarOp = True
1631 primOpNeedsWrapper DelayOp = True
1632 primOpNeedsWrapper WaitReadOp = True
1633 primOpNeedsWrapper WaitWriteOp = True
1635 primOpNeedsWrapper other_op = False
1640 = case (primOpInfo op) of
1642 Monadic str _ -> str
1643 Compare str _ -> str
1644 Coercing str _ _ -> str
1645 PrimResult str _ _ _ _ _ -> str
1646 AlgResult str _ _ _ _ -> str
1649 @primOpType@ duplicates some work of @primOpId@, but since we
1650 grab types pretty often...
1652 primOpType :: PrimOp -> Type
1655 = case (primOpInfo op) of
1656 Dyadic str ty -> dyadic_fun_ty ty
1657 Monadic str ty -> monadic_fun_ty ty
1658 Compare str ty -> compare_fun_ty ty
1659 Coercing str ty1 ty2 -> mkFunTys [ty1] ty2
1661 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1662 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1664 AlgResult str tyvars arg_tys tycon res_tys ->
1665 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1669 data PrimOpResultInfo
1670 = ReturnsPrim PrimRep
1673 -- ToDo: Deal with specialised PrimOps
1674 -- Will need to return specialised tycon and data constructors
1676 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1678 getPrimOpResultInfo op
1679 = case (primOpInfo op) of
1680 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1681 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1682 Compare _ ty -> ReturnsAlg boolTyCon
1683 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1684 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1685 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1687 isCompareOp :: PrimOp -> Bool
1690 = case primOpInfo op of
1695 The commutable ops are those for which we will try to move constants
1696 to the right hand side for strength reduction.
1699 commutableOp :: PrimOp -> Bool
1701 commutableOp CharEqOp = True
1702 commutableOp CharNeOp = True
1703 commutableOp IntAddOp = True
1704 commutableOp IntMulOp = True
1705 commutableOp AndOp = True
1706 commutableOp OrOp = True
1707 commutableOp IntEqOp = True
1708 commutableOp IntNeOp = True
1709 commutableOp IntegerAddOp = True
1710 commutableOp IntegerMulOp = True
1711 commutableOp FloatAddOp = True
1712 commutableOp FloatMulOp = True
1713 commutableOp FloatEqOp = True
1714 commutableOp FloatNeOp = True
1715 commutableOp DoubleAddOp = True
1716 commutableOp DoubleMulOp = True
1717 commutableOp DoubleEqOp = True
1718 commutableOp DoubleNeOp = True
1719 commutableOp _ = False
1724 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1725 monadic_fun_ty ty = mkFunTys [ty] ty
1726 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1731 pprPrimOp :: PprStyle -> PrimOp -> Pretty
1732 showPrimOp :: PprStyle -> PrimOp -> String
1735 = ppShow 1000{-random-} (pprPrimOp sty op)
1737 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1741 if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
1743 if may_gc then "(_ccall_GC_ " else "(_ccall_ "
1746 = if is_casm then ppStr "''" else ppNil
1749 = ppBesides [ppStr " { [",
1750 ppIntersperse pp'SP{-'-} (map (pprParendGenType sty) arg_tys),
1751 ppRbrack, ppSP, pprParendGenType sty res_ty, ppStr " })"]
1754 ppBesides [ppStr before, ppPStr fun, after, pp_tys]
1756 pprPrimOp sty other_op
1758 str = primOp_str other_op
1764 instance Outputable PrimOp where
1765 ppr sty op = pprPrimOp sty op