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,
24 -- export for the Native Code Generator
25 primOpInfo, -- needed for primOpNameInfo
33 import PrimRep -- most of it
37 import CStrings ( identToC )
38 import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
39 import HeapOffs ( addOff, intOff, totHdrSize )
40 import PprStyle ( codeStyle )
41 import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
43 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
44 import TyCon ( TyCon{-instances-} )
45 import Type ( getAppDataTyCon, maybeAppDataTyCon,
46 mkForAllTys, mkFunTys, applyTyCon, typePrimRep
48 import TyVar ( alphaTyVar, betaTyVar, GenTyVar{-instance Eq-} )
49 import Unique ( Unique{-instance Eq-} )
50 import Util ( panic#, assoc, panic{-ToDo:rm-} )
53 %************************************************************************
55 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
57 %************************************************************************
59 These are in \tr{state-interface.verb} order.
63 -- dig the FORTRAN/C influence on the names...
67 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
68 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
69 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
70 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
71 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
72 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
78 -- IntAbsOp unused?? ADR
79 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
80 | IntRemOp | IntNegOp | IntAbsOp
83 | AndOp | OrOp | NotOp
84 | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
85 | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
86 | Int2WordOp | Word2IntOp -- casts
89 | Int2AddrOp | Addr2IntOp -- casts
91 -- Float#-related ops:
92 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
93 | Float2IntOp | Int2FloatOp
95 | FloatExpOp | FloatLogOp | FloatSqrtOp
96 | FloatSinOp | FloatCosOp | FloatTanOp
97 | FloatAsinOp | FloatAcosOp | FloatAtanOp
98 | FloatSinhOp | FloatCoshOp | FloatTanhOp
99 -- not all machines have these available conveniently:
100 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
101 | FloatPowerOp -- ** op
103 -- Double#-related ops:
104 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
105 | Double2IntOp | Int2DoubleOp
106 | Double2FloatOp | Float2DoubleOp
108 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
109 | DoubleSinOp | DoubleCosOp | DoubleTanOp
110 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
111 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
112 -- not all machines have these available conveniently:
113 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
114 | DoublePowerOp -- ** op
116 -- Integer (and related...) ops:
117 -- slightly weird -- to match GMP package.
118 | IntegerAddOp | IntegerSubOp | IntegerMulOp
119 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
123 | Integer2IntOp | Int2IntegerOp
125 | Addr2IntegerOp -- "Addr" is *always* a literal string
128 | FloatEncodeOp | FloatDecodeOp
129 | DoubleEncodeOp | DoubleDecodeOp
131 -- primitive ops for primitive arrays
134 | NewByteArrayOp PrimRep
137 | SameMutableByteArrayOp
139 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
141 | ReadByteArrayOp PrimRep
142 | WriteByteArrayOp PrimRep
143 | IndexByteArrayOp PrimRep
144 | IndexOffAddrOp PrimRep
145 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
146 -- This is just a cheesy encoding of a bunch of ops.
147 -- Note that MallocPtrRep is not included -- the only way of
148 -- creating a MallocPtr is with a ccall or casm.
150 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
152 | NewSynchVarOp -- for MVars and IVars
153 | TakeMVarOp | PutMVarOp
154 | ReadIVarOp | WriteIVarOp
156 | MakeStablePtrOp | DeRefStablePtrOp
159 A special ``trap-door'' to use in making calls direct to C functions:
161 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
162 Bool -- True <=> really a "casm"
163 Bool -- True <=> might invoke Haskell GC
164 [Type] -- Unboxed argument; the state-token
165 -- argument will have been put *first*
166 Type -- Return type; one of the "StateAnd<blah>#" types
168 -- (... to be continued ... )
171 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
172 (See @primOpInfo@ for details.)
174 Note: that first arg and part of the result should be the system state
175 token (which we carry around to fool over-zealous optimisers) but
176 which isn't actually passed.
178 For example, we represent
180 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
186 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
187 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
191 (AlgAlts [ ( FloatPrimAndIoWorld,
193 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
199 Nota Bene: there are some people who find the empty list of types in
200 the @Prim@ somewhat puzzling and would represent the above by
204 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
205 -- :: /\ alpha1, alpha2 alpha3, alpha4.
206 -- alpha1 -> alpha2 -> alpha3 -> alpha4
207 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
210 (AlgAlts [ ( FloatPrimAndIoWorld,
212 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
218 But, this is a completely different way of using @CCallOp@. The most
219 major changes required if we switch to this are in @primOpInfo@, and
220 the desugarer. The major difficulty is in moving the HeapRequirement
221 stuff somewhere appropriate. (The advantage is that we could simplify
222 @CCallOp@ and record just the number of arguments with corresponding
223 simplifications in reading pragma unfoldings, the simplifier,
224 instantiation (etc) of core expressions, ... . Maybe we should think
225 about using it this way?? ADR)
228 -- (... continued from above ... )
230 -- one to support "errorIO" (and, thereby, "error")
233 -- Operation to test two closure addresses for equality (yes really!)
234 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
235 | ReallyUnsafePtrEqualityOp
237 -- three for parallel stuff
242 -- two for concurrency
247 | ParGlobalOp -- named global par
248 | ParLocalOp -- named local par
249 | ParAtOp -- specifies destination of local par
250 | ParAtForNowOp -- specifies initial destination of global par
251 | CopyableOp -- marks copyable code
252 | NoFollowOp -- marks non-followup expression
256 Deriving Ix is what we really want! ToDo
257 (Chk around before deleting...)
259 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
260 tagOf_PrimOp CharGeOp = ILIT( 2)
261 tagOf_PrimOp CharEqOp = ILIT( 3)
262 tagOf_PrimOp CharNeOp = ILIT( 4)
263 tagOf_PrimOp CharLtOp = ILIT( 5)
264 tagOf_PrimOp CharLeOp = ILIT( 6)
265 tagOf_PrimOp IntGtOp = ILIT( 7)
266 tagOf_PrimOp IntGeOp = ILIT( 8)
267 tagOf_PrimOp IntEqOp = ILIT( 9)
268 tagOf_PrimOp IntNeOp = ILIT( 10)
269 tagOf_PrimOp IntLtOp = ILIT( 11)
270 tagOf_PrimOp IntLeOp = ILIT( 12)
271 tagOf_PrimOp WordGtOp = ILIT( 13)
272 tagOf_PrimOp WordGeOp = ILIT( 14)
273 tagOf_PrimOp WordEqOp = ILIT( 15)
274 tagOf_PrimOp WordNeOp = ILIT( 16)
275 tagOf_PrimOp WordLtOp = ILIT( 17)
276 tagOf_PrimOp WordLeOp = ILIT( 18)
277 tagOf_PrimOp AddrGtOp = ILIT( 19)
278 tagOf_PrimOp AddrGeOp = ILIT( 20)
279 tagOf_PrimOp AddrEqOp = ILIT( 21)
280 tagOf_PrimOp AddrNeOp = ILIT( 22)
281 tagOf_PrimOp AddrLtOp = ILIT( 23)
282 tagOf_PrimOp AddrLeOp = ILIT( 24)
283 tagOf_PrimOp FloatGtOp = ILIT( 25)
284 tagOf_PrimOp FloatGeOp = ILIT( 26)
285 tagOf_PrimOp FloatEqOp = ILIT( 27)
286 tagOf_PrimOp FloatNeOp = ILIT( 28)
287 tagOf_PrimOp FloatLtOp = ILIT( 29)
288 tagOf_PrimOp FloatLeOp = ILIT( 30)
289 tagOf_PrimOp DoubleGtOp = ILIT( 31)
290 tagOf_PrimOp DoubleGeOp = ILIT( 32)
291 tagOf_PrimOp DoubleEqOp = ILIT( 33)
292 tagOf_PrimOp DoubleNeOp = ILIT( 34)
293 tagOf_PrimOp DoubleLtOp = ILIT( 35)
294 tagOf_PrimOp DoubleLeOp = ILIT( 36)
295 tagOf_PrimOp OrdOp = ILIT( 37)
296 tagOf_PrimOp ChrOp = ILIT( 38)
297 tagOf_PrimOp IntAddOp = ILIT( 39)
298 tagOf_PrimOp IntSubOp = ILIT( 40)
299 tagOf_PrimOp IntMulOp = ILIT( 41)
300 tagOf_PrimOp IntQuotOp = ILIT( 42)
301 tagOf_PrimOp IntRemOp = ILIT( 44)
302 tagOf_PrimOp IntNegOp = ILIT( 45)
303 tagOf_PrimOp IntAbsOp = ILIT( 46)
304 tagOf_PrimOp AndOp = ILIT( 47)
305 tagOf_PrimOp OrOp = ILIT( 48)
306 tagOf_PrimOp NotOp = ILIT( 49)
307 tagOf_PrimOp SllOp = ILIT( 50)
308 tagOf_PrimOp SraOp = ILIT( 51)
309 tagOf_PrimOp SrlOp = ILIT( 52)
310 tagOf_PrimOp ISllOp = ILIT( 53)
311 tagOf_PrimOp ISraOp = ILIT( 54)
312 tagOf_PrimOp ISrlOp = ILIT( 55)
313 tagOf_PrimOp Int2WordOp = ILIT( 56)
314 tagOf_PrimOp Word2IntOp = ILIT( 57)
315 tagOf_PrimOp Int2AddrOp = ILIT( 58)
316 tagOf_PrimOp Addr2IntOp = ILIT( 59)
317 tagOf_PrimOp FloatAddOp = ILIT( 60)
318 tagOf_PrimOp FloatSubOp = ILIT( 61)
319 tagOf_PrimOp FloatMulOp = ILIT( 62)
320 tagOf_PrimOp FloatDivOp = ILIT( 63)
321 tagOf_PrimOp FloatNegOp = ILIT( 64)
322 tagOf_PrimOp Float2IntOp = ILIT( 65)
323 tagOf_PrimOp Int2FloatOp = ILIT( 66)
324 tagOf_PrimOp FloatExpOp = ILIT( 67)
325 tagOf_PrimOp FloatLogOp = ILIT( 68)
326 tagOf_PrimOp FloatSqrtOp = ILIT( 69)
327 tagOf_PrimOp FloatSinOp = ILIT( 70)
328 tagOf_PrimOp FloatCosOp = ILIT( 71)
329 tagOf_PrimOp FloatTanOp = ILIT( 72)
330 tagOf_PrimOp FloatAsinOp = ILIT( 73)
331 tagOf_PrimOp FloatAcosOp = ILIT( 74)
332 tagOf_PrimOp FloatAtanOp = ILIT( 75)
333 tagOf_PrimOp FloatSinhOp = ILIT( 76)
334 tagOf_PrimOp FloatCoshOp = ILIT( 77)
335 tagOf_PrimOp FloatTanhOp = ILIT( 78)
336 tagOf_PrimOp FloatPowerOp = ILIT( 79)
337 tagOf_PrimOp DoubleAddOp = ILIT( 80)
338 tagOf_PrimOp DoubleSubOp = ILIT( 81)
339 tagOf_PrimOp DoubleMulOp = ILIT( 82)
340 tagOf_PrimOp DoubleDivOp = ILIT( 83)
341 tagOf_PrimOp DoubleNegOp = ILIT( 84)
342 tagOf_PrimOp Double2IntOp = ILIT( 85)
343 tagOf_PrimOp Int2DoubleOp = ILIT( 86)
344 tagOf_PrimOp Double2FloatOp = ILIT( 87)
345 tagOf_PrimOp Float2DoubleOp = ILIT( 88)
346 tagOf_PrimOp DoubleExpOp = ILIT( 89)
347 tagOf_PrimOp DoubleLogOp = ILIT( 90)
348 tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
349 tagOf_PrimOp DoubleSinOp = ILIT( 92)
350 tagOf_PrimOp DoubleCosOp = ILIT( 93)
351 tagOf_PrimOp DoubleTanOp = ILIT( 94)
352 tagOf_PrimOp DoubleAsinOp = ILIT( 95)
353 tagOf_PrimOp DoubleAcosOp = ILIT( 96)
354 tagOf_PrimOp DoubleAtanOp = ILIT( 97)
355 tagOf_PrimOp DoubleSinhOp = ILIT( 98)
356 tagOf_PrimOp DoubleCoshOp = ILIT( 99)
357 tagOf_PrimOp DoubleTanhOp = ILIT(100)
358 tagOf_PrimOp DoublePowerOp = ILIT(101)
359 tagOf_PrimOp IntegerAddOp = ILIT(102)
360 tagOf_PrimOp IntegerSubOp = ILIT(103)
361 tagOf_PrimOp IntegerMulOp = ILIT(104)
362 tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
363 tagOf_PrimOp IntegerDivModOp = ILIT(106)
364 tagOf_PrimOp IntegerNegOp = ILIT(107)
365 tagOf_PrimOp IntegerCmpOp = ILIT(108)
366 tagOf_PrimOp Integer2IntOp = ILIT(109)
367 tagOf_PrimOp Int2IntegerOp = ILIT(110)
368 tagOf_PrimOp Word2IntegerOp = ILIT(111)
369 tagOf_PrimOp Addr2IntegerOp = ILIT(112)
370 tagOf_PrimOp FloatEncodeOp = ILIT(113)
371 tagOf_PrimOp FloatDecodeOp = ILIT(114)
372 tagOf_PrimOp DoubleEncodeOp = ILIT(115)
373 tagOf_PrimOp DoubleDecodeOp = ILIT(116)
374 tagOf_PrimOp NewArrayOp = ILIT(117)
375 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
376 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
377 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
378 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
379 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
380 tagOf_PrimOp SameMutableArrayOp = ILIT(123)
381 tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
382 tagOf_PrimOp ReadArrayOp = ILIT(125)
383 tagOf_PrimOp WriteArrayOp = ILIT(126)
384 tagOf_PrimOp IndexArrayOp = ILIT(127)
385 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
386 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
387 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
388 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
389 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
390 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
391 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
392 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
393 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
394 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
395 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
396 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
397 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
398 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
399 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
400 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
401 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
402 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
403 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
404 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
405 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
406 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
407 tagOf_PrimOp NewSynchVarOp = ILIT(150)
408 tagOf_PrimOp TakeMVarOp = ILIT(151)
409 tagOf_PrimOp PutMVarOp = ILIT(152)
410 tagOf_PrimOp ReadIVarOp = ILIT(153)
411 tagOf_PrimOp WriteIVarOp = ILIT(154)
412 tagOf_PrimOp MakeStablePtrOp = ILIT(155)
413 tagOf_PrimOp DeRefStablePtrOp = ILIT(156)
414 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(157)
415 tagOf_PrimOp ErrorIOPrimOp = ILIT(158)
416 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(159)
417 tagOf_PrimOp SeqOp = ILIT(160)
418 tagOf_PrimOp ParOp = ILIT(161)
419 tagOf_PrimOp ForkOp = ILIT(162)
420 tagOf_PrimOp DelayOp = ILIT(163)
421 tagOf_PrimOp WaitOp = ILIT(164)
424 tagOf_PrimOp ParGlobalOp = ILIT(165)
425 tagOf_PrimOp ParLocalOp = ILIT(166)
426 tagOf_PrimOp ParAtOp = ILIT(167)
427 tagOf_PrimOp ParAtForNowOp = ILIT(168)
428 tagOf_PrimOp CopyableOp = ILIT(169)
429 tagOf_PrimOp NoFollowOp = ILIT(170)
432 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
434 instance Eq PrimOp where
435 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
438 An @Enum@-derived list would be better; meanwhile... (ToDo)
556 NewByteArrayOp CharRep,
557 NewByteArrayOp IntRep,
558 NewByteArrayOp AddrRep,
559 NewByteArrayOp FloatRep,
560 NewByteArrayOp DoubleRep,
562 SameMutableByteArrayOp,
566 ReadByteArrayOp CharRep,
567 ReadByteArrayOp IntRep,
568 ReadByteArrayOp AddrRep,
569 ReadByteArrayOp FloatRep,
570 ReadByteArrayOp DoubleRep,
571 WriteByteArrayOp CharRep,
572 WriteByteArrayOp IntRep,
573 WriteByteArrayOp AddrRep,
574 WriteByteArrayOp FloatRep,
575 WriteByteArrayOp DoubleRep,
576 IndexByteArrayOp CharRep,
577 IndexByteArrayOp IntRep,
578 IndexByteArrayOp AddrRep,
579 IndexByteArrayOp FloatRep,
580 IndexByteArrayOp DoubleRep,
581 IndexOffAddrOp CharRep,
582 IndexOffAddrOp IntRep,
583 IndexOffAddrOp AddrRep,
584 IndexOffAddrOp FloatRep,
585 IndexOffAddrOp DoubleRep,
587 UnsafeFreezeByteArrayOp,
596 ReallyUnsafePtrEqualityOp,
610 %************************************************************************
612 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
614 %************************************************************************
616 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
617 refer to the primitive operation. The conventional \tr{#}-for-
618 unboxed ops is added on later.
620 The reason for the funny characters in the names is so we do not
621 interfere with the programmer's Haskell name spaces.
623 We use @PrimKinds@ for the ``type'' information, because they're
624 (slightly) more convenient to use than @TyCons@.
627 = Dyadic FAST_STRING -- string :: T -> T -> T
629 | Monadic FAST_STRING -- string :: T -> T
631 | Compare FAST_STRING -- string :: T -> T -> Bool
633 | Coercing FAST_STRING -- string :: T1 -> T2
637 | PrimResult FAST_STRING
638 [TyVar] [Type] TyCon PrimRep [Type]
639 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
640 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
641 -- D# is a primitive type constructor.
642 -- (the kind is the same info as D#, in another convenient form)
644 | AlgResult FAST_STRING
645 [TyVar] [Type] TyCon [Type]
646 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
647 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
649 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
654 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
656 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
657 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
658 an_Integer_and_Int_tys
659 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
662 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
664 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
666 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
668 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
671 @primOpInfo@ gives all essential information (from which everything
672 else, notably a type, can be constructed) for each @PrimOp@.
675 primOpInfo :: PrimOp -> PrimOpInfo
678 There's plenty of this stuff!
680 %************************************************************************
682 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
684 %************************************************************************
687 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
688 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
689 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
690 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
691 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
692 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
694 primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
695 primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
696 primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
697 primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
698 primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
699 primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
701 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
702 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
703 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
704 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
705 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
706 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
708 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
709 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
710 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
711 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
712 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
713 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
715 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
716 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
717 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
718 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
719 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
720 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
722 primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
723 primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
724 primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
725 primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
726 primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
727 primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
730 %************************************************************************
732 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
734 %************************************************************************
737 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
738 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
741 %************************************************************************
743 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
745 %************************************************************************
748 primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
749 primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
750 primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
751 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
752 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
754 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
757 %************************************************************************
759 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
761 %************************************************************************
763 A @Word#@ is an unsigned @Int#@.
766 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
767 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
768 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
771 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
773 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
775 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
778 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
780 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
782 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
784 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
785 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
788 %************************************************************************
790 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
792 %************************************************************************
795 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
796 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
799 %************************************************************************
801 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
803 %************************************************************************
805 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
809 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
810 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
811 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
812 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
813 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
815 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
816 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
818 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
819 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
820 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
821 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
822 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
823 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
824 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
825 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
826 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
827 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
828 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
829 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
830 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
833 %************************************************************************
835 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
837 %************************************************************************
839 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
843 primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
844 primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
845 primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
846 primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
847 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
849 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
850 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
852 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
853 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
855 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
856 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
857 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
858 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
859 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
860 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
861 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
862 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
863 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
864 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
865 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
866 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
867 primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
870 %************************************************************************
872 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
874 %************************************************************************
877 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
879 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
880 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
881 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
883 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
885 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
886 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
888 primOpInfo Integer2IntOp
889 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
891 primOpInfo Int2IntegerOp
892 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
894 primOpInfo Word2IntegerOp
895 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
897 primOpInfo Addr2IntegerOp
898 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
901 Encoding and decoding of floating-point numbers is sorta
905 primOpInfo FloatEncodeOp
906 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
907 floatPrimTyCon FloatRep []
909 primOpInfo DoubleEncodeOp
910 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
911 doublePrimTyCon DoubleRep []
913 primOpInfo FloatDecodeOp
914 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
916 primOpInfo DoubleDecodeOp
917 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
920 %************************************************************************
922 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
924 %************************************************************************
927 primOpInfo NewArrayOp
929 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
931 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
932 stateAndMutableArrayPrimTyCon [s, elt]
934 primOpInfo (NewByteArrayOp kind)
936 s = alphaTy; s_tv = alphaTyVar
938 (str, _, prim_tycon) = getPrimRepInfo kind
940 op_str = _PK_ ("new" ++ str ++ "Array#")
942 AlgResult op_str [s_tv]
943 [intPrimTy, mkStatePrimTy s]
944 stateAndMutableByteArrayPrimTyCon [s]
946 ---------------------------------------------------------------------------
948 primOpInfo SameMutableArrayOp
950 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
951 mut_arr_ty = mkMutableArrayPrimTy s elt
953 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
956 primOpInfo SameMutableByteArrayOp
958 s = alphaTy; s_tv = alphaTyVar;
959 mut_arr_ty = mkMutableByteArrayPrimTy s
961 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
964 ---------------------------------------------------------------------------
965 -- Primitive arrays of Haskell pointers:
967 primOpInfo ReadArrayOp
969 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
971 AlgResult SLIT("readArray#") [s_tv, elt_tv]
972 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
973 stateAndPtrPrimTyCon [s, elt]
976 primOpInfo WriteArrayOp
978 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
980 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
981 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
982 statePrimTyCon VoidRep [s]
984 primOpInfo IndexArrayOp
985 = let { elt = alphaTy; elt_tv = alphaTyVar } in
986 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
989 ---------------------------------------------------------------------------
990 -- Primitive arrays full of unboxed bytes:
992 primOpInfo (ReadByteArrayOp kind)
994 s = alphaTy; s_tv = alphaTyVar
996 (str, _, prim_tycon) = getPrimRepInfo kind
998 op_str = _PK_ ("read" ++ str ++ "Array#")
999 relevant_tycon = assoc "primOpInfo" tbl kind
1001 AlgResult op_str [s_tv]
1002 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1005 tbl = [ (CharRep, stateAndCharPrimTyCon),
1006 (IntRep, stateAndIntPrimTyCon),
1007 (AddrRep, stateAndAddrPrimTyCon),
1008 (FloatRep, stateAndFloatPrimTyCon),
1009 (DoubleRep, stateAndDoublePrimTyCon) ]
1011 -- How come there's no Word byte arrays? ADR
1013 primOpInfo (WriteByteArrayOp kind)
1015 s = alphaTy; s_tv = alphaTyVar
1017 (str, prim_ty, _) = getPrimRepInfo kind
1018 op_str = _PK_ ("write" ++ str ++ "Array#")
1020 -- NB: *Prim*Result --
1021 PrimResult op_str [s_tv]
1022 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1023 statePrimTyCon VoidRep [s]
1025 primOpInfo (IndexByteArrayOp kind)
1027 (str, _, prim_tycon) = getPrimRepInfo kind
1028 op_str = _PK_ ("index" ++ str ++ "Array#")
1030 -- NB: *Prim*Result --
1031 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1033 primOpInfo (IndexOffAddrOp kind)
1035 (str, _, prim_tycon) = getPrimRepInfo kind
1036 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1038 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1040 ---------------------------------------------------------------------------
1041 primOpInfo UnsafeFreezeArrayOp
1043 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1045 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1046 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1047 stateAndArrayPrimTyCon [s, elt]
1049 primOpInfo UnsafeFreezeByteArrayOp
1050 = let { s = alphaTy; s_tv = alphaTyVar } in
1051 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1052 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1053 stateAndByteArrayPrimTyCon [s]
1056 %************************************************************************
1058 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1060 %************************************************************************
1063 primOpInfo NewSynchVarOp
1065 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1067 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1068 stateAndSynchVarPrimTyCon [s, elt]
1070 primOpInfo TakeMVarOp
1072 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1074 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1075 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1076 stateAndPtrPrimTyCon [s, elt]
1078 primOpInfo PutMVarOp
1080 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1082 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1083 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1086 primOpInfo ReadIVarOp
1088 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1090 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1091 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1092 stateAndPtrPrimTyCon [s, elt]
1094 primOpInfo WriteIVarOp
1096 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1098 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1099 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1104 %************************************************************************
1106 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1108 %************************************************************************
1114 s = alphaTy; s_tv = alphaTyVar
1116 PrimResult SLIT("delay#") [s_tv]
1117 [intPrimTy, mkStatePrimTy s]
1118 statePrimTyCon VoidRep [s]
1122 s = alphaTy; s_tv = alphaTyVar
1124 PrimResult SLIT("wait#") [s_tv]
1125 [intPrimTy, mkStatePrimTy s]
1126 statePrimTyCon VoidRep [s]
1131 %************************************************************************
1133 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1135 %************************************************************************
1137 A {\em stable pointer} is an index into a table of pointers into the
1138 heap. Since the garbage collector is told about stable pointers, it
1139 is safe to pass a stable pointer to external systems such as C
1142 Here's what the operations and types are supposed to be (from
1143 state-interface document).
1146 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1147 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1148 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1151 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1152 operation since it doesn't (directly) involve IO operations. The
1153 reason is that if some optimisation pass decided to duplicate calls to
1154 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1155 massive space leak can result. Putting it into the PrimIO monad
1156 prevents this. (Another reason for putting them in a monad is to
1157 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1160 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1161 besides, it's not likely to be used from Haskell) so it's not a
1164 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1167 primOpInfo MakeStablePtrOp
1168 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1169 [alphaTy, realWorldStatePrimTy]
1170 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1172 primOpInfo DeRefStablePtrOp
1173 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1174 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1175 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1178 %************************************************************************
1180 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1182 %************************************************************************
1184 [Alastair Reid is to blame for this!]
1186 These days, (Glasgow) Haskell seems to have a bit of everything from
1187 other languages: strict operations, mutable variables, sequencing,
1188 pointers, etc. About the only thing left is LISP's ability to test
1189 for pointer equality. So, let's add it in!
1192 reallyUnsafePtrEquality :: a -> a -> Int#
1195 which tests any two closures (of the same type) to see if they're the
1196 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1197 difficulties of trying to box up the result.)
1199 NB This is {\em really unsafe\/} because even something as trivial as
1200 a garbage collection might change the answer by removing indirections.
1201 Still, no-one's forcing you to use it. If you're worried about little
1202 things like loss of referential transparency, you might like to wrap
1203 it all up in a monad-like thing as John O'Donnell and John Hughes did
1204 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1207 I'm thinking of using it to speed up a critical equality test in some
1208 graphics stuff in a context where the possibility of saying that
1209 denotationally equal things aren't isn't a problem (as long as it
1210 doesn't happen too often.) ADR
1212 To Will: Jim said this was already in, but I can't see it so I'm
1213 adding it. Up to you whether you add it. (Note that this could have
1214 been readily implemented using a @veryDangerousCCall@ before they were
1218 primOpInfo ReallyUnsafePtrEqualityOp
1219 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1220 [alphaTy, alphaTy] intPrimTyCon IntRep []
1223 %************************************************************************
1225 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1227 %************************************************************************
1230 primOpInfo SeqOp -- seq# :: a -> Int#
1231 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1233 primOpInfo ParOp -- par# :: a -> Int#
1234 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1236 primOpInfo ForkOp -- fork# :: a -> Int#
1237 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1244 primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b
1245 = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1247 primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b
1248 = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1250 primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c
1251 = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1253 primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c
1254 = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1256 primOpInfo CopyableOp -- copyable# :: a -> a
1257 = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1259 primOpInfo NoFollowOp -- noFollow# :: a -> a
1260 = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1265 %************************************************************************
1267 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1269 %************************************************************************
1272 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1273 = PrimResult SLIT("errorIO#") []
1275 statePrimTyCon VoidRep [realWorldTy]
1278 %************************************************************************
1280 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1282 %************************************************************************
1285 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1286 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1288 (result_tycon, tys_applied, _) = _trace "getAppDataTyCon.PrimOp" $ getAppDataTyCon result_ty
1291 %************************************************************************
1293 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1295 %************************************************************************
1297 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1298 with @Integers@ can trigger GC. Here we describe the heap requirements
1299 of the various @PrimOps@. For most, no heap is required. For a few,
1300 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1301 be combined with the rest of the heap usage in the basic block. For an
1302 unfortunate few, some unknown amount of heap is required (these are the
1303 ops which can trigger GC).
1306 data HeapRequirement
1308 | FixedHeapRequired HeapOffset
1309 | VariableHeapRequired
1311 primOpHeapReq :: PrimOp -> HeapRequirement
1313 primOpHeapReq NewArrayOp = VariableHeapRequired
1314 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1316 primOpHeapReq IntegerAddOp = VariableHeapRequired
1317 primOpHeapReq IntegerSubOp = VariableHeapRequired
1318 primOpHeapReq IntegerMulOp = VariableHeapRequired
1319 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1320 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1321 primOpHeapReq IntegerNegOp = VariableHeapRequired
1322 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1323 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1324 (intOff mIN_MP_INT_SIZE))
1325 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1326 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1327 (intOff mIN_MP_INT_SIZE))
1328 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1329 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1330 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1331 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1332 (intOff mIN_MP_INT_SIZE)))
1333 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1334 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1335 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1336 (intOff mIN_MP_INT_SIZE)))
1338 -- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1339 -- or if it returns a MallocPtr.
1341 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1342 primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty)
1343 = if returnsMallocPtr
1344 then VariableHeapRequired
1348 = case (maybeAppDataTyCon return_ty) of
1350 Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon
1352 -- this occasionally has to expand the Stable Pointer table
1353 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1355 -- These four only need heap space with the native code generator
1356 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1358 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1359 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1360 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1361 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1363 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1364 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1365 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1367 -- Sparking ops no longer allocate any heap; however, _fork_ may
1368 -- require a context switch to clear space in the required thread
1369 -- pool, and that requires liveness information.
1371 primOpHeapReq ParOp = NoHeapRequired
1372 primOpHeapReq ForkOp = VariableHeapRequired
1374 -- A SeqOp requires unknown space to evaluate its argument
1375 primOpHeapReq SeqOp = VariableHeapRequired
1379 -- a ParGlobalOp creates a single 4-tuple in the heap. ToDo: verify this!
1380 primOpHeapReq ParGlobalOp = trace "primOpHeapReq:ParGlobalOp:verify!" (
1382 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1385 -- a ParLocalOp creates a single 4-tuple in the heap. ToDo: verify this!
1386 primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" (
1388 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1391 -- ToDo: parAt, parAtForNow, copyable, noFollow !! (HWL)
1394 primOpHeapReq other_op = NoHeapRequired
1397 Primops which can trigger GC have to be called carefully.
1398 In particular, their arguments are guaranteed to be in registers,
1399 and a liveness mask tells which regs are live.
1402 primOpCanTriggerGC op
1409 case primOpHeapReq op of
1410 VariableHeapRequired -> True
1414 Sometimes we may choose to execute a PrimOp even though it isn't
1415 certain that its result will be required; ie execute them
1416 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1417 this is OK, because PrimOps are usually cheap, but it isn't OK for
1418 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1420 See also @primOpIsCheap@ (below).
1422 There should be no worries about side effects; that's all taken care
1423 of by data dependencies.
1426 primOpOkForSpeculation :: PrimOp -> Bool
1429 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1430 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1433 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1434 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1436 -- Float. ToDo: tan? tanh?
1437 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1438 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1439 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1440 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1442 -- Double. ToDo: tan? tanh?
1443 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1444 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1445 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1446 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1449 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1452 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1455 primOpOkForSpeculation ParOp = False -- Could be expensive!
1456 primOpOkForSpeculation ForkOp = False -- Likewise
1457 primOpOkForSpeculation SeqOp = False -- Likewise
1460 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1461 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1464 -- The default is "yes it's ok for speculation"
1465 primOpOkForSpeculation other_op = True
1468 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1469 WARNING), we just borrow some other predicates for a
1470 what-should-be-good-enough test.
1473 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1476 And some primops have side-effects and so, for example, must not be
1480 fragilePrimOp :: PrimOp -> Bool
1482 fragilePrimOp ParOp = True
1483 fragilePrimOp ForkOp = True
1484 fragilePrimOp SeqOp = True
1485 fragilePrimOp MakeStablePtrOp = True
1486 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1489 fragilePrimOp ParGlobalOp = True
1490 fragilePrimOp ParLocalOp = True
1491 fragilePrimOp CopyableOp = trace "fragilePrimOp:CopyableOp" True -- Possibly not. ASP
1492 fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly not. ASP
1495 fragilePrimOp other = False
1498 Primitive operations that perform calls need wrappers to save any live variables
1499 that are stored in caller-saves registers
1502 primOpNeedsWrapper :: PrimOp -> Bool
1504 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1506 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1507 primOpNeedsWrapper (NewByteArrayOp _) = True
1509 primOpNeedsWrapper IntegerAddOp = True
1510 primOpNeedsWrapper IntegerSubOp = True
1511 primOpNeedsWrapper IntegerMulOp = True
1512 primOpNeedsWrapper IntegerQuotRemOp = True
1513 primOpNeedsWrapper IntegerDivModOp = True
1514 primOpNeedsWrapper IntegerNegOp = True
1515 primOpNeedsWrapper IntegerCmpOp = True
1516 primOpNeedsWrapper Integer2IntOp = True
1517 primOpNeedsWrapper Int2IntegerOp = True
1518 primOpNeedsWrapper Word2IntegerOp = True
1519 primOpNeedsWrapper Addr2IntegerOp = True
1521 primOpNeedsWrapper FloatExpOp = True
1522 primOpNeedsWrapper FloatLogOp = True
1523 primOpNeedsWrapper FloatSqrtOp = True
1524 primOpNeedsWrapper FloatSinOp = True
1525 primOpNeedsWrapper FloatCosOp = True
1526 primOpNeedsWrapper FloatTanOp = True
1527 primOpNeedsWrapper FloatAsinOp = True
1528 primOpNeedsWrapper FloatAcosOp = True
1529 primOpNeedsWrapper FloatAtanOp = True
1530 primOpNeedsWrapper FloatSinhOp = True
1531 primOpNeedsWrapper FloatCoshOp = True
1532 primOpNeedsWrapper FloatTanhOp = True
1533 primOpNeedsWrapper FloatPowerOp = True
1534 primOpNeedsWrapper FloatEncodeOp = True
1535 primOpNeedsWrapper FloatDecodeOp = True
1537 primOpNeedsWrapper DoubleExpOp = True
1538 primOpNeedsWrapper DoubleLogOp = True
1539 primOpNeedsWrapper DoubleSqrtOp = True
1540 primOpNeedsWrapper DoubleSinOp = True
1541 primOpNeedsWrapper DoubleCosOp = True
1542 primOpNeedsWrapper DoubleTanOp = True
1543 primOpNeedsWrapper DoubleAsinOp = True
1544 primOpNeedsWrapper DoubleAcosOp = True
1545 primOpNeedsWrapper DoubleAtanOp = True
1546 primOpNeedsWrapper DoubleSinhOp = True
1547 primOpNeedsWrapper DoubleCoshOp = True
1548 primOpNeedsWrapper DoubleTanhOp = True
1549 primOpNeedsWrapper DoublePowerOp = True
1550 primOpNeedsWrapper DoubleEncodeOp = True
1551 primOpNeedsWrapper DoubleDecodeOp = True
1553 primOpNeedsWrapper MakeStablePtrOp = True
1554 primOpNeedsWrapper DeRefStablePtrOp = True
1556 primOpNeedsWrapper TakeMVarOp = True
1557 primOpNeedsWrapper PutMVarOp = True
1558 primOpNeedsWrapper ReadIVarOp = True
1560 primOpNeedsWrapper DelayOp = True
1561 primOpNeedsWrapper WaitOp = True
1563 primOpNeedsWrapper other_op = False
1568 = case (primOpInfo op) of
1570 Monadic str _ -> str
1571 Compare str _ -> str
1572 Coercing str _ _ -> str
1573 PrimResult str _ _ _ _ _ -> str
1574 AlgResult str _ _ _ _ -> str
1577 @primOpType@ duplicates some work of @primOpId@, but since we
1578 grab types pretty often...
1580 primOpType :: PrimOp -> Type
1583 = case (primOpInfo op) of
1584 Dyadic str ty -> dyadic_fun_ty ty
1585 Monadic str ty -> monadic_fun_ty ty
1586 Compare str ty -> compare_fun_ty ty
1587 Coercing str ty1 ty2 -> mkFunTys [ty1] ty2
1589 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1590 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1592 AlgResult str tyvars arg_tys tycon res_tys ->
1593 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1597 data PrimOpResultInfo
1598 = ReturnsPrim PrimRep
1601 -- ToDo: Deal with specialised PrimOps
1602 -- Will need to return specialised tycon and data constructors
1604 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1606 getPrimOpResultInfo op
1607 = case (primOpInfo op) of
1608 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1609 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1610 Compare _ ty -> ReturnsAlg boolTyCon
1611 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1612 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1613 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1615 isCompareOp :: PrimOp -> Bool
1618 = case primOpInfo op of
1623 The commutable ops are those for which we will try to move constants
1624 to the right hand side for strength reduction.
1627 commutableOp :: PrimOp -> Bool
1629 commutableOp CharEqOp = True
1630 commutableOp CharNeOp = True
1631 commutableOp IntAddOp = True
1632 commutableOp IntMulOp = True
1633 commutableOp AndOp = True
1634 commutableOp OrOp = True
1635 commutableOp IntEqOp = True
1636 commutableOp IntNeOp = True
1637 commutableOp IntegerAddOp = True
1638 commutableOp IntegerMulOp = True
1639 commutableOp FloatAddOp = True
1640 commutableOp FloatMulOp = True
1641 commutableOp FloatEqOp = True
1642 commutableOp FloatNeOp = True
1643 commutableOp DoubleAddOp = True
1644 commutableOp DoubleMulOp = True
1645 commutableOp DoubleEqOp = True
1646 commutableOp DoubleNeOp = True
1647 commutableOp _ = False
1652 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1653 monadic_fun_ty ty = mkFunTys [ty] ty
1654 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1659 pprPrimOp :: PprStyle -> PrimOp -> Pretty
1660 showPrimOp :: PprStyle -> PrimOp -> String
1663 = ppShow 1000{-random-} (pprPrimOp sty op)
1665 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1669 if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
1671 if may_gc then "(_ccall_GC_ " else "(_ccall_ "
1674 = if is_casm then ppStr "''" else ppNil
1677 = ppBesides [ppStr " { [",
1678 ppIntersperse pp'SP{-'-} (map (pprParendGenType sty) arg_tys),
1679 ppRbrack, ppSP, pprParendGenType sty res_ty, ppStr " })"]
1682 ppBesides [ppStr before, ppPStr fun, after, pp_tys]
1684 pprPrimOp sty other_op
1686 str = primOp_str other_op
1692 instance Outputable PrimOp where
1693 ppr sty op = pprPrimOp sty op