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 NameTypes ( mkPreludeCoreName, FullName, ShortName )
41 import PprStyle ( codeStyle )
42 import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
44 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
45 import TyCon ( TyCon{-instances-} )
46 import Type ( getAppDataTyCon, maybeAppDataTyCon,
47 mkForAllTys, mkFunTys, applyTyCon, typePrimRep
49 import TyVar ( alphaTyVar, betaTyVar, 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 MallocPtrRep is not included -- the only way of
149 -- creating a MallocPtr is with a ccall or casm.
151 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
153 | NewSynchVarOp -- for MVars and IVars
154 | TakeMVarOp | PutMVarOp
155 | ReadIVarOp | WriteIVarOp
157 | MakeStablePtrOp | DeRefStablePtrOp
160 A special ``trap-door'' to use in making calls direct to C functions:
162 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
163 Bool -- True <=> really a "casm"
164 Bool -- True <=> might invoke Haskell GC
165 [Type] -- Unboxed argument; the state-token
166 -- argument will have been put *first*
167 Type -- Return type; one of the "StateAnd<blah>#" types
169 -- (... to be continued ... )
172 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
173 (See @primOpInfo@ for details.)
175 Note: that first arg and part of the result should be the system state
176 token (which we carry around to fool over-zealous optimisers) but
177 which isn't actually passed.
179 For example, we represent
181 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
187 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
188 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
192 (AlgAlts [ ( FloatPrimAndIoWorld,
194 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
200 Nota Bene: there are some people who find the empty list of types in
201 the @Prim@ somewhat puzzling and would represent the above by
205 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
206 -- :: /\ alpha1, alpha2 alpha3, alpha4.
207 -- alpha1 -> alpha2 -> alpha3 -> alpha4
208 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
211 (AlgAlts [ ( FloatPrimAndIoWorld,
213 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
219 But, this is a completely different way of using @CCallOp@. The most
220 major changes required if we switch to this are in @primOpInfo@, and
221 the desugarer. The major difficulty is in moving the HeapRequirement
222 stuff somewhere appropriate. (The advantage is that we could simplify
223 @CCallOp@ and record just the number of arguments with corresponding
224 simplifications in reading pragma unfoldings, the simplifier,
225 instantiation (etc) of core expressions, ... . Maybe we should think
226 about using it this way?? ADR)
229 -- (... continued from above ... )
231 -- one to support "errorIO" (and, thereby, "error")
234 -- Operation to test two closure addresses for equality (yes really!)
235 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
236 | ReallyUnsafePtrEqualityOp
238 -- three for parallel stuff
243 -- two for concurrency
248 | ParGlobalOp -- named global par
249 | ParLocalOp -- named local par
250 | ParAtOp -- specifies destination of local par
251 | ParAtForNowOp -- specifies initial destination of global par
252 | CopyableOp -- marks copyable code
253 | NoFollowOp -- marks non-followup expression
257 Deriving Ix is what we really want! ToDo
258 (Chk around before deleting...)
260 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
261 tagOf_PrimOp CharGeOp = ILIT( 2)
262 tagOf_PrimOp CharEqOp = ILIT( 3)
263 tagOf_PrimOp CharNeOp = ILIT( 4)
264 tagOf_PrimOp CharLtOp = ILIT( 5)
265 tagOf_PrimOp CharLeOp = ILIT( 6)
266 tagOf_PrimOp IntGtOp = ILIT( 7)
267 tagOf_PrimOp IntGeOp = ILIT( 8)
268 tagOf_PrimOp IntEqOp = ILIT( 9)
269 tagOf_PrimOp IntNeOp = ILIT( 10)
270 tagOf_PrimOp IntLtOp = ILIT( 11)
271 tagOf_PrimOp IntLeOp = ILIT( 12)
272 tagOf_PrimOp WordGtOp = ILIT( 13)
273 tagOf_PrimOp WordGeOp = ILIT( 14)
274 tagOf_PrimOp WordEqOp = ILIT( 15)
275 tagOf_PrimOp WordNeOp = ILIT( 16)
276 tagOf_PrimOp WordLtOp = ILIT( 17)
277 tagOf_PrimOp WordLeOp = ILIT( 18)
278 tagOf_PrimOp AddrGtOp = ILIT( 19)
279 tagOf_PrimOp AddrGeOp = ILIT( 20)
280 tagOf_PrimOp AddrEqOp = ILIT( 21)
281 tagOf_PrimOp AddrNeOp = ILIT( 22)
282 tagOf_PrimOp AddrLtOp = ILIT( 23)
283 tagOf_PrimOp AddrLeOp = ILIT( 24)
284 tagOf_PrimOp FloatGtOp = ILIT( 25)
285 tagOf_PrimOp FloatGeOp = ILIT( 26)
286 tagOf_PrimOp FloatEqOp = ILIT( 27)
287 tagOf_PrimOp FloatNeOp = ILIT( 28)
288 tagOf_PrimOp FloatLtOp = ILIT( 29)
289 tagOf_PrimOp FloatLeOp = ILIT( 30)
290 tagOf_PrimOp DoubleGtOp = ILIT( 31)
291 tagOf_PrimOp DoubleGeOp = ILIT( 32)
292 tagOf_PrimOp DoubleEqOp = ILIT( 33)
293 tagOf_PrimOp DoubleNeOp = ILIT( 34)
294 tagOf_PrimOp DoubleLtOp = ILIT( 35)
295 tagOf_PrimOp DoubleLeOp = ILIT( 36)
296 tagOf_PrimOp OrdOp = ILIT( 37)
297 tagOf_PrimOp ChrOp = ILIT( 38)
298 tagOf_PrimOp IntAddOp = ILIT( 39)
299 tagOf_PrimOp IntSubOp = ILIT( 40)
300 tagOf_PrimOp IntMulOp = ILIT( 41)
301 tagOf_PrimOp IntQuotOp = ILIT( 42)
302 tagOf_PrimOp IntRemOp = ILIT( 44)
303 tagOf_PrimOp IntNegOp = ILIT( 45)
304 tagOf_PrimOp IntAbsOp = ILIT( 46)
305 tagOf_PrimOp AndOp = ILIT( 47)
306 tagOf_PrimOp OrOp = ILIT( 48)
307 tagOf_PrimOp NotOp = ILIT( 49)
308 tagOf_PrimOp SllOp = ILIT( 50)
309 tagOf_PrimOp SraOp = ILIT( 51)
310 tagOf_PrimOp SrlOp = ILIT( 52)
311 tagOf_PrimOp ISllOp = ILIT( 53)
312 tagOf_PrimOp ISraOp = ILIT( 54)
313 tagOf_PrimOp ISrlOp = ILIT( 55)
314 tagOf_PrimOp Int2WordOp = ILIT( 56)
315 tagOf_PrimOp Word2IntOp = ILIT( 57)
316 tagOf_PrimOp Int2AddrOp = ILIT( 58)
317 tagOf_PrimOp Addr2IntOp = ILIT( 59)
318 tagOf_PrimOp FloatAddOp = ILIT( 60)
319 tagOf_PrimOp FloatSubOp = ILIT( 61)
320 tagOf_PrimOp FloatMulOp = ILIT( 62)
321 tagOf_PrimOp FloatDivOp = ILIT( 63)
322 tagOf_PrimOp FloatNegOp = ILIT( 64)
323 tagOf_PrimOp Float2IntOp = ILIT( 65)
324 tagOf_PrimOp Int2FloatOp = ILIT( 66)
325 tagOf_PrimOp FloatExpOp = ILIT( 67)
326 tagOf_PrimOp FloatLogOp = ILIT( 68)
327 tagOf_PrimOp FloatSqrtOp = ILIT( 69)
328 tagOf_PrimOp FloatSinOp = ILIT( 70)
329 tagOf_PrimOp FloatCosOp = ILIT( 71)
330 tagOf_PrimOp FloatTanOp = ILIT( 72)
331 tagOf_PrimOp FloatAsinOp = ILIT( 73)
332 tagOf_PrimOp FloatAcosOp = ILIT( 74)
333 tagOf_PrimOp FloatAtanOp = ILIT( 75)
334 tagOf_PrimOp FloatSinhOp = ILIT( 76)
335 tagOf_PrimOp FloatCoshOp = ILIT( 77)
336 tagOf_PrimOp FloatTanhOp = ILIT( 78)
337 tagOf_PrimOp FloatPowerOp = ILIT( 79)
338 tagOf_PrimOp DoubleAddOp = ILIT( 80)
339 tagOf_PrimOp DoubleSubOp = ILIT( 81)
340 tagOf_PrimOp DoubleMulOp = ILIT( 82)
341 tagOf_PrimOp DoubleDivOp = ILIT( 83)
342 tagOf_PrimOp DoubleNegOp = ILIT( 84)
343 tagOf_PrimOp Double2IntOp = ILIT( 85)
344 tagOf_PrimOp Int2DoubleOp = ILIT( 86)
345 tagOf_PrimOp Double2FloatOp = ILIT( 87)
346 tagOf_PrimOp Float2DoubleOp = ILIT( 88)
347 tagOf_PrimOp DoubleExpOp = ILIT( 89)
348 tagOf_PrimOp DoubleLogOp = ILIT( 90)
349 tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
350 tagOf_PrimOp DoubleSinOp = ILIT( 92)
351 tagOf_PrimOp DoubleCosOp = ILIT( 93)
352 tagOf_PrimOp DoubleTanOp = ILIT( 94)
353 tagOf_PrimOp DoubleAsinOp = ILIT( 95)
354 tagOf_PrimOp DoubleAcosOp = ILIT( 96)
355 tagOf_PrimOp DoubleAtanOp = ILIT( 97)
356 tagOf_PrimOp DoubleSinhOp = ILIT( 98)
357 tagOf_PrimOp DoubleCoshOp = ILIT( 99)
358 tagOf_PrimOp DoubleTanhOp = ILIT(100)
359 tagOf_PrimOp DoublePowerOp = ILIT(101)
360 tagOf_PrimOp IntegerAddOp = ILIT(102)
361 tagOf_PrimOp IntegerSubOp = ILIT(103)
362 tagOf_PrimOp IntegerMulOp = ILIT(104)
363 tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
364 tagOf_PrimOp IntegerDivModOp = ILIT(106)
365 tagOf_PrimOp IntegerNegOp = ILIT(107)
366 tagOf_PrimOp IntegerCmpOp = ILIT(108)
367 tagOf_PrimOp Integer2IntOp = ILIT(109)
368 tagOf_PrimOp Int2IntegerOp = ILIT(110)
369 tagOf_PrimOp Word2IntegerOp = ILIT(111)
370 tagOf_PrimOp Addr2IntegerOp = ILIT(112)
371 tagOf_PrimOp FloatEncodeOp = ILIT(113)
372 tagOf_PrimOp FloatDecodeOp = ILIT(114)
373 tagOf_PrimOp DoubleEncodeOp = ILIT(115)
374 tagOf_PrimOp DoubleDecodeOp = ILIT(116)
375 tagOf_PrimOp NewArrayOp = ILIT(117)
376 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
377 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
378 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
379 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
380 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
381 tagOf_PrimOp SameMutableArrayOp = ILIT(123)
382 tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
383 tagOf_PrimOp ReadArrayOp = ILIT(125)
384 tagOf_PrimOp WriteArrayOp = ILIT(126)
385 tagOf_PrimOp IndexArrayOp = ILIT(127)
386 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
387 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
388 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
389 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
390 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
391 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
392 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
393 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
394 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
395 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
396 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
397 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
398 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
399 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
400 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
401 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
402 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
403 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
404 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
405 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
406 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
407 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
408 tagOf_PrimOp NewSynchVarOp = ILIT(150)
409 tagOf_PrimOp TakeMVarOp = ILIT(151)
410 tagOf_PrimOp PutMVarOp = ILIT(152)
411 tagOf_PrimOp ReadIVarOp = ILIT(153)
412 tagOf_PrimOp WriteIVarOp = ILIT(154)
413 tagOf_PrimOp MakeStablePtrOp = ILIT(155)
414 tagOf_PrimOp DeRefStablePtrOp = ILIT(156)
415 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(157)
416 tagOf_PrimOp ErrorIOPrimOp = ILIT(158)
417 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(159)
418 tagOf_PrimOp SeqOp = ILIT(160)
419 tagOf_PrimOp ParOp = ILIT(161)
420 tagOf_PrimOp ForkOp = ILIT(162)
421 tagOf_PrimOp DelayOp = ILIT(163)
422 tagOf_PrimOp WaitOp = ILIT(164)
425 tagOf_PrimOp ParGlobalOp = ILIT(165)
426 tagOf_PrimOp ParLocalOp = ILIT(166)
427 tagOf_PrimOp ParAtOp = ILIT(167)
428 tagOf_PrimOp ParAtForNowOp = ILIT(168)
429 tagOf_PrimOp CopyableOp = ILIT(169)
430 tagOf_PrimOp NoFollowOp = ILIT(170)
433 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
435 instance Eq PrimOp where
436 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
439 An @Enum@-derived list would be better; meanwhile... (ToDo)
557 NewByteArrayOp CharRep,
558 NewByteArrayOp IntRep,
559 NewByteArrayOp AddrRep,
560 NewByteArrayOp FloatRep,
561 NewByteArrayOp DoubleRep,
563 SameMutableByteArrayOp,
567 ReadByteArrayOp CharRep,
568 ReadByteArrayOp IntRep,
569 ReadByteArrayOp AddrRep,
570 ReadByteArrayOp FloatRep,
571 ReadByteArrayOp DoubleRep,
572 WriteByteArrayOp CharRep,
573 WriteByteArrayOp IntRep,
574 WriteByteArrayOp AddrRep,
575 WriteByteArrayOp FloatRep,
576 WriteByteArrayOp DoubleRep,
577 IndexByteArrayOp CharRep,
578 IndexByteArrayOp IntRep,
579 IndexByteArrayOp AddrRep,
580 IndexByteArrayOp FloatRep,
581 IndexByteArrayOp DoubleRep,
582 IndexOffAddrOp CharRep,
583 IndexOffAddrOp IntRep,
584 IndexOffAddrOp AddrRep,
585 IndexOffAddrOp FloatRep,
586 IndexOffAddrOp DoubleRep,
588 UnsafeFreezeByteArrayOp,
597 ReallyUnsafePtrEqualityOp,
611 %************************************************************************
613 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
615 %************************************************************************
617 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
618 refer to the primitive operation. The conventional \tr{#}-for-
619 unboxed ops is added on later.
621 The reason for the funny characters in the names is so we do not
622 interfere with the programmer's Haskell name spaces.
624 We use @PrimKinds@ for the ``type'' information, because they're
625 (slightly) more convenient to use than @TyCons@.
628 = Dyadic FAST_STRING -- string :: T -> T -> T
630 | Monadic FAST_STRING -- string :: T -> T
632 | Compare FAST_STRING -- string :: T -> T -> Bool
634 | Coerce FAST_STRING -- string :: T1 -> T2
638 | PrimResult FAST_STRING
639 [TyVar] [Type] TyCon PrimRep [Type]
640 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
641 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
642 -- D# is a primitive type constructor.
643 -- (the kind is the same info as D#, in another convenient form)
645 | AlgResult FAST_STRING
646 [TyVar] [Type] TyCon [Type]
647 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
648 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
650 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
655 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
657 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
658 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
659 an_Integer_and_Int_tys
660 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
663 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
665 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
667 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
669 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
672 @primOpInfo@ gives all essential information (from which everything
673 else, notably a type, can be constructed) for each @PrimOp@.
676 primOpInfo :: PrimOp -> PrimOpInfo
679 There's plenty of this stuff!
681 %************************************************************************
683 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
685 %************************************************************************
688 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
689 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
690 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
691 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
692 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
693 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
695 primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
696 primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
697 primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
698 primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
699 primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
700 primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
702 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
703 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
704 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
705 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
706 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
707 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
709 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
710 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
711 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
712 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
713 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
714 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
716 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
717 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
718 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
719 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
720 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
721 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
723 primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
724 primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
725 primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
726 primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
727 primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
728 primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
731 %************************************************************************
733 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
735 %************************************************************************
738 primOpInfo OrdOp = Coerce SLIT("ord#") charPrimTy intPrimTy
739 primOpInfo ChrOp = Coerce SLIT("chr#") intPrimTy charPrimTy
742 %************************************************************************
744 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
746 %************************************************************************
749 primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
750 primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
751 primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
752 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
753 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
755 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
758 %************************************************************************
760 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
762 %************************************************************************
764 A @Word#@ is an unsigned @Int#@.
767 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
768 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
769 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
772 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
774 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
776 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
779 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
781 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
783 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
785 primOpInfo Int2WordOp = Coerce SLIT("int2Word#") intPrimTy wordPrimTy
786 primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy
789 %************************************************************************
791 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
793 %************************************************************************
796 primOpInfo Int2AddrOp = Coerce SLIT("int2Addr#") intPrimTy addrPrimTy
797 primOpInfo Addr2IntOp = Coerce SLIT("addr2Int#") addrPrimTy intPrimTy
800 %************************************************************************
802 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
804 %************************************************************************
806 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
810 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
811 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
812 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
813 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
814 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
816 primOpInfo Float2IntOp = Coerce SLIT("float2Int#") floatPrimTy intPrimTy
817 primOpInfo Int2FloatOp = Coerce SLIT("int2Float#") intPrimTy floatPrimTy
819 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
820 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
821 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
822 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
823 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
824 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
825 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
826 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
827 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
828 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
829 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
830 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
831 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
834 %************************************************************************
836 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
838 %************************************************************************
840 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
844 primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
845 primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
846 primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
847 primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
848 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
850 primOpInfo Double2IntOp = Coerce SLIT("double2Int#") doublePrimTy intPrimTy
851 primOpInfo Int2DoubleOp = Coerce SLIT("int2Double#") intPrimTy doublePrimTy
853 primOpInfo Double2FloatOp = Coerce SLIT("double2Float#") doublePrimTy floatPrimTy
854 primOpInfo Float2DoubleOp = Coerce SLIT("float2Double#") floatPrimTy doublePrimTy
856 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
857 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
858 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
859 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
860 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
861 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
862 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
863 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
864 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
865 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
866 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
867 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
868 primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
871 %************************************************************************
873 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
875 %************************************************************************
878 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
880 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
881 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
882 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
884 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
886 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
887 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
889 primOpInfo Integer2IntOp
890 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
892 primOpInfo Int2IntegerOp
893 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
895 primOpInfo Word2IntegerOp
896 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
898 primOpInfo Addr2IntegerOp
899 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
902 Encoding and decoding of floating-point numbers is sorta
906 primOpInfo FloatEncodeOp
907 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
908 floatPrimTyCon FloatRep []
910 primOpInfo DoubleEncodeOp
911 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
912 doublePrimTyCon DoubleRep []
914 primOpInfo FloatDecodeOp
915 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
917 primOpInfo DoubleDecodeOp
918 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
921 %************************************************************************
923 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
925 %************************************************************************
928 primOpInfo NewArrayOp
930 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
932 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
933 stateAndMutableArrayPrimTyCon [s, elt]
935 primOpInfo (NewByteArrayOp kind)
937 s = alphaTy; s_tv = alphaTyVar
939 (str, _, prim_tycon) = getPrimRepInfo kind
941 op_str = _PK_ ("new" ++ str ++ "Array#")
943 AlgResult op_str [s_tv]
944 [intPrimTy, mkStatePrimTy s]
945 stateAndMutableByteArrayPrimTyCon [s]
947 ---------------------------------------------------------------------------
949 primOpInfo SameMutableArrayOp
951 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
952 mut_arr_ty = mkMutableArrayPrimTy s elt
954 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
957 primOpInfo SameMutableByteArrayOp
959 s = alphaTy; s_tv = alphaTyVar;
960 mut_arr_ty = mkMutableByteArrayPrimTy s
962 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
965 ---------------------------------------------------------------------------
966 -- Primitive arrays of Haskell pointers:
968 primOpInfo ReadArrayOp
970 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
972 AlgResult SLIT("readArray#") [s_tv, elt_tv]
973 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
974 stateAndPtrPrimTyCon [s, elt]
977 primOpInfo WriteArrayOp
979 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
981 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
982 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
983 statePrimTyCon VoidRep [s]
985 primOpInfo IndexArrayOp
986 = let { elt = alphaTy; elt_tv = alphaTyVar } in
987 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
990 ---------------------------------------------------------------------------
991 -- Primitive arrays full of unboxed bytes:
993 primOpInfo (ReadByteArrayOp kind)
995 s = alphaTy; s_tv = alphaTyVar
997 (str, _, prim_tycon) = getPrimRepInfo kind
999 op_str = _PK_ ("read" ++ str ++ "Array#")
1000 relevant_tycon = assoc "primOpInfo" tbl kind
1002 AlgResult op_str [s_tv]
1003 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1006 tbl = [ (CharRep, stateAndCharPrimTyCon),
1007 (IntRep, stateAndIntPrimTyCon),
1008 (AddrRep, stateAndAddrPrimTyCon),
1009 (FloatRep, stateAndFloatPrimTyCon),
1010 (DoubleRep, stateAndDoublePrimTyCon) ]
1012 -- How come there's no Word byte arrays? ADR
1014 primOpInfo (WriteByteArrayOp kind)
1016 s = alphaTy; s_tv = alphaTyVar
1018 (str, prim_ty, _) = getPrimRepInfo kind
1019 op_str = _PK_ ("write" ++ str ++ "Array#")
1021 -- NB: *Prim*Result --
1022 PrimResult op_str [s_tv]
1023 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1024 statePrimTyCon VoidRep [s]
1026 primOpInfo (IndexByteArrayOp kind)
1028 (str, _, prim_tycon) = getPrimRepInfo kind
1029 op_str = _PK_ ("index" ++ str ++ "Array#")
1031 -- NB: *Prim*Result --
1032 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1034 primOpInfo (IndexOffAddrOp kind)
1036 (str, _, prim_tycon) = getPrimRepInfo kind
1037 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1039 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1041 ---------------------------------------------------------------------------
1042 primOpInfo UnsafeFreezeArrayOp
1044 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1046 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1047 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1048 stateAndArrayPrimTyCon [s, elt]
1050 primOpInfo UnsafeFreezeByteArrayOp
1051 = let { s = alphaTy; s_tv = alphaTyVar } in
1052 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1053 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1054 stateAndByteArrayPrimTyCon [s]
1057 %************************************************************************
1059 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1061 %************************************************************************
1064 primOpInfo NewSynchVarOp
1066 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1068 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1069 stateAndSynchVarPrimTyCon [s, elt]
1071 primOpInfo TakeMVarOp
1073 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1075 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1076 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1077 stateAndPtrPrimTyCon [s, elt]
1079 primOpInfo PutMVarOp
1081 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1083 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1084 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1087 primOpInfo ReadIVarOp
1089 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1091 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1092 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1093 stateAndPtrPrimTyCon [s, elt]
1095 primOpInfo WriteIVarOp
1097 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1099 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1100 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1105 %************************************************************************
1107 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1109 %************************************************************************
1115 s = alphaTy; s_tv = alphaTyVar
1117 PrimResult SLIT("delay#") [s_tv]
1118 [intPrimTy, mkStatePrimTy s]
1119 statePrimTyCon VoidRep [s]
1123 s = alphaTy; s_tv = alphaTyVar
1125 PrimResult SLIT("wait#") [s_tv]
1126 [intPrimTy, mkStatePrimTy s]
1127 statePrimTyCon VoidRep [s]
1132 %************************************************************************
1134 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1136 %************************************************************************
1138 A {\em stable pointer} is an index into a table of pointers into the
1139 heap. Since the garbage collector is told about stable pointers, it
1140 is safe to pass a stable pointer to external systems such as C
1143 Here's what the operations and types are supposed to be (from
1144 state-interface document).
1147 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1148 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1149 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1152 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1153 operation since it doesn't (directly) involve IO operations. The
1154 reason is that if some optimisation pass decided to duplicate calls to
1155 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1156 massive space leak can result. Putting it into the PrimIO monad
1157 prevents this. (Another reason for putting them in a monad is to
1158 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1161 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1162 besides, it's not likely to be used from Haskell) so it's not a
1165 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1168 primOpInfo MakeStablePtrOp
1169 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1170 [alphaTy, realWorldStatePrimTy]
1171 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1173 primOpInfo DeRefStablePtrOp
1174 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1175 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1176 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1179 %************************************************************************
1181 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1183 %************************************************************************
1185 [Alastair Reid is to blame for this!]
1187 These days, (Glasgow) Haskell seems to have a bit of everything from
1188 other languages: strict operations, mutable variables, sequencing,
1189 pointers, etc. About the only thing left is LISP's ability to test
1190 for pointer equality. So, let's add it in!
1193 reallyUnsafePtrEquality :: a -> a -> Int#
1196 which tests any two closures (of the same type) to see if they're the
1197 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1198 difficulties of trying to box up the result.)
1200 NB This is {\em really unsafe\/} because even something as trivial as
1201 a garbage collection might change the answer by removing indirections.
1202 Still, no-one's forcing you to use it. If you're worried about little
1203 things like loss of referential transparency, you might like to wrap
1204 it all up in a monad-like thing as John O'Donnell and John Hughes did
1205 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1208 I'm thinking of using it to speed up a critical equality test in some
1209 graphics stuff in a context where the possibility of saying that
1210 denotationally equal things aren't isn't a problem (as long as it
1211 doesn't happen too often.) ADR
1213 To Will: Jim said this was already in, but I can't see it so I'm
1214 adding it. Up to you whether you add it. (Note that this could have
1215 been readily implemented using a @veryDangerousCCall@ before they were
1219 primOpInfo ReallyUnsafePtrEqualityOp
1220 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1221 [alphaTy, alphaTy] intPrimTyCon IntRep []
1224 %************************************************************************
1226 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1228 %************************************************************************
1231 primOpInfo SeqOp -- seq# :: a -> Int#
1232 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1234 primOpInfo ParOp -- par# :: a -> Int#
1235 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1237 primOpInfo ForkOp -- fork# :: a -> Int#
1238 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1245 primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b
1246 = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1248 primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b
1249 = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1251 primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c
1252 = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1254 primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c
1255 = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1257 primOpInfo CopyableOp -- copyable# :: a -> a
1258 = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1260 primOpInfo NoFollowOp -- noFollow# :: a -> a
1261 = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1266 %************************************************************************
1268 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1270 %************************************************************************
1273 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1274 = PrimResult SLIT("errorIO#") []
1276 statePrimTyCon VoidRep [realWorldTy]
1279 %************************************************************************
1281 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1283 %************************************************************************
1286 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1287 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1289 (result_tycon, tys_applied, _) = getAppDataTyCon result_ty
1292 %************************************************************************
1294 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1296 %************************************************************************
1298 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1299 with @Integers@ can trigger GC. Here we describe the heap requirements
1300 of the various @PrimOps@. For most, no heap is required. For a few,
1301 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1302 be combined with the rest of the heap usage in the basic block. For an
1303 unfortunate few, some unknown amount of heap is required (these are the
1304 ops which can trigger GC).
1307 data HeapRequirement
1309 | FixedHeapRequired HeapOffset
1310 | VariableHeapRequired
1312 primOpHeapReq :: PrimOp -> HeapRequirement
1314 primOpHeapReq NewArrayOp = VariableHeapRequired
1315 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1317 primOpHeapReq IntegerAddOp = VariableHeapRequired
1318 primOpHeapReq IntegerSubOp = VariableHeapRequired
1319 primOpHeapReq IntegerMulOp = VariableHeapRequired
1320 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1321 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1322 primOpHeapReq IntegerNegOp = VariableHeapRequired
1323 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1324 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1325 (intOff mIN_MP_INT_SIZE))
1326 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1327 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1328 (intOff mIN_MP_INT_SIZE))
1329 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1330 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1331 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1332 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1333 (intOff mIN_MP_INT_SIZE)))
1334 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1335 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1336 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1337 (intOff mIN_MP_INT_SIZE)))
1339 -- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1340 -- or if it returns a MallocPtr.
1342 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1343 primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty)
1344 = if returnsMallocPtr
1345 then VariableHeapRequired
1349 = case (maybeAppDataTyCon return_ty) of
1351 Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon
1353 -- this occasionally has to expand the Stable Pointer table
1354 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1356 -- These four only need heap space with the native code generator
1357 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1359 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1360 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1361 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1362 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1364 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1365 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1366 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1368 -- Sparking ops no longer allocate any heap; however, _fork_ may
1369 -- require a context switch to clear space in the required thread
1370 -- pool, and that requires liveness information.
1372 primOpHeapReq ParOp = NoHeapRequired
1373 primOpHeapReq ForkOp = VariableHeapRequired
1375 -- A SeqOp requires unknown space to evaluate its argument
1376 primOpHeapReq SeqOp = VariableHeapRequired
1380 -- a ParGlobalOp creates a single 4-tuple in the heap. ToDo: verify this!
1381 primOpHeapReq ParGlobalOp = trace "primOpHeapReq:ParGlobalOp:verify!" (
1383 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1386 -- a ParLocalOp creates a single 4-tuple in the heap. ToDo: verify this!
1387 primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" (
1389 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1392 -- ToDo: parAt, parAtForNow, copyable, noFollow !! (HWL)
1395 primOpHeapReq other_op = NoHeapRequired
1398 Primops which can trigger GC have to be called carefully.
1399 In particular, their arguments are guaranteed to be in registers,
1400 and a liveness mask tells which regs are live.
1403 primOpCanTriggerGC op
1410 case primOpHeapReq op of
1411 VariableHeapRequired -> True
1415 Sometimes we may choose to execute a PrimOp even though it isn't
1416 certain that its result will be required; ie execute them
1417 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1418 this is OK, because PrimOps are usually cheap, but it isn't OK for
1419 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1421 See also @primOpIsCheap@ (below).
1423 There should be no worries about side effects; that's all taken care
1424 of by data dependencies.
1427 primOpOkForSpeculation :: PrimOp -> Bool
1430 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1431 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1434 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1435 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1437 -- Float. ToDo: tan? tanh?
1438 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1439 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1440 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1441 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1443 -- Double. ToDo: tan? tanh?
1444 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1445 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1446 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1447 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1450 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1453 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1456 primOpOkForSpeculation ParOp = False -- Could be expensive!
1457 primOpOkForSpeculation ForkOp = False -- Likewise
1458 primOpOkForSpeculation SeqOp = False -- Likewise
1461 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1462 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1465 -- The default is "yes it's ok for speculation"
1466 primOpOkForSpeculation other_op = True
1469 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1470 WARNING), we just borrow some other predicates for a
1471 what-should-be-good-enough test.
1474 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1477 And some primops have side-effects and so, for example, must not be
1481 fragilePrimOp :: PrimOp -> Bool
1483 fragilePrimOp ParOp = True
1484 fragilePrimOp ForkOp = True
1485 fragilePrimOp SeqOp = True
1486 fragilePrimOp MakeStablePtrOp = True
1487 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1490 fragilePrimOp ParGlobalOp = True
1491 fragilePrimOp ParLocalOp = True
1492 fragilePrimOp CopyableOp = trace "fragilePrimOp:CopyableOp" True -- Possibly not. ASP
1493 fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly not. ASP
1496 fragilePrimOp other = False
1499 Primitive operations that perform calls need wrappers to save any live variables
1500 that are stored in caller-saves registers
1503 primOpNeedsWrapper :: PrimOp -> Bool
1505 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1507 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1508 primOpNeedsWrapper (NewByteArrayOp _) = True
1510 primOpNeedsWrapper IntegerAddOp = True
1511 primOpNeedsWrapper IntegerSubOp = True
1512 primOpNeedsWrapper IntegerMulOp = True
1513 primOpNeedsWrapper IntegerQuotRemOp = True
1514 primOpNeedsWrapper IntegerDivModOp = True
1515 primOpNeedsWrapper IntegerNegOp = True
1516 primOpNeedsWrapper IntegerCmpOp = True
1517 primOpNeedsWrapper Integer2IntOp = True
1518 primOpNeedsWrapper Int2IntegerOp = True
1519 primOpNeedsWrapper Word2IntegerOp = True
1520 primOpNeedsWrapper Addr2IntegerOp = True
1522 primOpNeedsWrapper FloatExpOp = True
1523 primOpNeedsWrapper FloatLogOp = True
1524 primOpNeedsWrapper FloatSqrtOp = True
1525 primOpNeedsWrapper FloatSinOp = True
1526 primOpNeedsWrapper FloatCosOp = True
1527 primOpNeedsWrapper FloatTanOp = True
1528 primOpNeedsWrapper FloatAsinOp = True
1529 primOpNeedsWrapper FloatAcosOp = True
1530 primOpNeedsWrapper FloatAtanOp = True
1531 primOpNeedsWrapper FloatSinhOp = True
1532 primOpNeedsWrapper FloatCoshOp = True
1533 primOpNeedsWrapper FloatTanhOp = True
1534 primOpNeedsWrapper FloatPowerOp = True
1535 primOpNeedsWrapper FloatEncodeOp = True
1536 primOpNeedsWrapper FloatDecodeOp = True
1538 primOpNeedsWrapper DoubleExpOp = True
1539 primOpNeedsWrapper DoubleLogOp = True
1540 primOpNeedsWrapper DoubleSqrtOp = True
1541 primOpNeedsWrapper DoubleSinOp = True
1542 primOpNeedsWrapper DoubleCosOp = True
1543 primOpNeedsWrapper DoubleTanOp = True
1544 primOpNeedsWrapper DoubleAsinOp = True
1545 primOpNeedsWrapper DoubleAcosOp = True
1546 primOpNeedsWrapper DoubleAtanOp = True
1547 primOpNeedsWrapper DoubleSinhOp = True
1548 primOpNeedsWrapper DoubleCoshOp = True
1549 primOpNeedsWrapper DoubleTanhOp = True
1550 primOpNeedsWrapper DoublePowerOp = True
1551 primOpNeedsWrapper DoubleEncodeOp = True
1552 primOpNeedsWrapper DoubleDecodeOp = True
1554 primOpNeedsWrapper MakeStablePtrOp = True
1555 primOpNeedsWrapper DeRefStablePtrOp = True
1557 primOpNeedsWrapper TakeMVarOp = True
1558 primOpNeedsWrapper PutMVarOp = True
1559 primOpNeedsWrapper ReadIVarOp = True
1561 primOpNeedsWrapper DelayOp = True
1562 primOpNeedsWrapper WaitOp = True
1564 primOpNeedsWrapper other_op = False
1569 = case (primOpInfo op) of
1571 Monadic str _ -> str
1572 Compare str _ -> str
1573 Coerce str _ _ -> str
1574 PrimResult str _ _ _ _ _ -> str
1575 AlgResult str _ _ _ _ -> str
1578 @primOpType@ duplicates some work of @primOpId@, but since we
1579 grab types pretty often...
1581 primOpType :: PrimOp -> Type
1584 = case (primOpInfo op) of
1585 Dyadic str ty -> dyadic_fun_ty ty
1586 Monadic str ty -> monadic_fun_ty ty
1587 Compare str ty -> compare_fun_ty ty
1588 Coerce str ty1 ty2 -> mkFunTys [ty1] ty2
1590 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1591 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1593 AlgResult str tyvars arg_tys tycon res_tys ->
1594 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1598 data PrimOpResultInfo
1599 = ReturnsPrim PrimRep
1602 -- ToDo: Deal with specialised PrimOps
1603 -- Will need to return specialised tycon and data constructors
1605 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1607 getPrimOpResultInfo op
1608 = case (primOpInfo op) of
1609 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1610 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1611 Compare _ ty -> ReturnsAlg boolTyCon
1612 Coerce _ _ ty -> ReturnsPrim (typePrimRep ty)
1613 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1614 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1616 isCompareOp :: PrimOp -> Bool
1619 = case primOpInfo op of
1624 The commutable ops are those for which we will try to move constants
1625 to the right hand side for strength reduction.
1628 commutableOp :: PrimOp -> Bool
1630 commutableOp CharEqOp = True
1631 commutableOp CharNeOp = True
1632 commutableOp IntAddOp = True
1633 commutableOp IntMulOp = True
1634 commutableOp AndOp = True
1635 commutableOp OrOp = True
1636 commutableOp IntEqOp = True
1637 commutableOp IntNeOp = True
1638 commutableOp IntegerAddOp = True
1639 commutableOp IntegerMulOp = True
1640 commutableOp FloatAddOp = True
1641 commutableOp FloatMulOp = True
1642 commutableOp FloatEqOp = True
1643 commutableOp FloatNeOp = True
1644 commutableOp DoubleAddOp = True
1645 commutableOp DoubleMulOp = True
1646 commutableOp DoubleEqOp = True
1647 commutableOp DoubleNeOp = True
1648 commutableOp _ = False
1653 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1654 monadic_fun_ty ty = mkFunTys [ty] ty
1655 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1660 pprPrimOp :: PprStyle -> PrimOp -> Pretty
1661 showPrimOp :: PprStyle -> PrimOp -> String
1664 = ppShow 1000{-random-} (pprPrimOp sty op)
1666 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1670 if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
1672 if may_gc then "(_ccall_GC_ " else "(_ccall_ "
1675 = if is_casm then ppStr "''" else ppNil
1678 = ppBesides [ppStr " { [",
1679 ppIntersperse pp'SP{-'-} (map (pprParendGenType sty) arg_tys),
1680 ppRbrack, ppSP, pprParendGenType sty res_ty, ppStr " })"]
1683 ppBesides [ppStr before, ppPStr fun, after, pp_tys]
1685 pprPrimOp sty other_op
1687 str = primOp_str other_op
1693 instance Outputable PrimOp where
1694 ppr sty op = pprPrimOp sty op