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,
18 --MOVE: primOpCanTriggerGC, primOpNeedsWrapper,
19 --MOVE: primOpOkForSpeculation, primOpIsCheap,
20 --MOVE: fragilePrimOp,
21 --MOVE: HeapRequirement(..), primOpHeapReq,
23 -- export for the Native Code Generator
24 primOpInfo, -- needed for primOpNameInfo
29 -- and to make the interface self-sufficient....
34 import PrimRep -- most of it
38 import CStrings ( identToC )
39 import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
40 import NameTypes ( mkPreludeCoreName, FullName, ShortName )
41 import PprStyle ( codeStyle )
43 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
44 import TyCon ( TyCon{-instances-} )
45 import Type ( getAppDataTyCon, maybeAppDataTyCon,
46 mkForAllTys, mkFunTys, applyTyCon )
47 import TyVar ( alphaTyVar, betaTyVar )
48 import Util ( panic#, assoc, panic{-ToDo:rm-} )
50 glueTyArgs = panic "PrimOp:glueTyArgs"
51 pprParendType = panic "PrimOp:pprParendType"
52 primRepFromType = panic "PrimOp:primRepFromType"
55 %************************************************************************
57 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
59 %************************************************************************
61 These are in \tr{state-interface.verb} order.
65 -- dig the FORTRAN/C influence on the names...
69 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
70 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
71 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
72 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
73 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
74 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
80 -- IntAbsOp unused?? ADR
81 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
82 | IntRemOp | IntNegOp | IntAbsOp
85 | AndOp | OrOp | NotOp
86 | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,logical}
87 | ISllOp | ISraOp | ISrlOp -- equivs on Int#s
88 | Int2WordOp | Word2IntOp -- casts
91 | Int2AddrOp | Addr2IntOp -- casts
93 -- Float#-related ops:
94 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
95 | Float2IntOp | Int2FloatOp
97 | FloatExpOp | FloatLogOp | FloatSqrtOp
98 | FloatSinOp | FloatCosOp | FloatTanOp
99 | FloatAsinOp | FloatAcosOp | FloatAtanOp
100 | FloatSinhOp | FloatCoshOp | FloatTanhOp
101 -- not all machines have these available conveniently:
102 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
103 | FloatPowerOp -- ** op
105 -- Double#-related ops:
106 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
107 | Double2IntOp | Int2DoubleOp
108 | Double2FloatOp | Float2DoubleOp
110 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
111 | DoubleSinOp | DoubleCosOp | DoubleTanOp
112 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
113 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
114 -- not all machines have these available conveniently:
115 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
116 | DoublePowerOp -- ** op
118 -- Integer (and related...) ops:
119 -- slightly weird -- to match GMP package.
120 | IntegerAddOp | IntegerSubOp | IntegerMulOp
121 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
125 | Integer2IntOp | Int2IntegerOp
127 | Addr2IntegerOp -- "Addr" is *always* a literal string
130 | FloatEncodeOp | FloatDecodeOp
131 | DoubleEncodeOp | DoubleDecodeOp
133 -- primitive ops for primitive arrays
136 | NewByteArrayOp PrimRep
139 | SameMutableByteArrayOp
141 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
143 | ReadByteArrayOp PrimRep
144 | WriteByteArrayOp PrimRep
145 | IndexByteArrayOp PrimRep
146 | IndexOffAddrOp PrimRep
147 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
148 -- This is just a cheesy encoding of a bunch of ops.
149 -- Note that MallocPtrRep is not included -- the only way of
150 -- creating a MallocPtr is with a ccall or casm.
152 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
154 | NewSynchVarOp -- for MVars and IVars
155 | TakeMVarOp | PutMVarOp
156 | ReadIVarOp | WriteIVarOp
158 | MakeStablePtrOp | DeRefStablePtrOp
161 A special ``trap-door'' to use in making calls direct to C functions:
163 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
164 Bool -- True <=> really a "casm"
165 Bool -- True <=> might invoke Haskell GC
166 [Type] -- Unboxed argument; the state-token
167 -- argument will have been put *first*
168 Type -- Return type; one of the "StateAnd<blah>#" types
170 -- (... to be continued ... )
173 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
174 (See @primOpInfo@ for details.)
176 Note: that first arg and part of the result should be the system state
177 token (which we carry around to fool over-zealous optimisers) but
178 which isn't actually passed.
180 For example, we represent
182 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
188 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
189 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
193 (AlgAlts [ ( FloatPrimAndIoWorld,
195 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
201 Nota Bene: there are some people who find the empty list of types in
202 the @Prim@ somewhat puzzling and would represent the above by
206 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
207 -- :: /\ alpha1, alpha2 alpha3, alpha4.
208 -- alpha1 -> alpha2 -> alpha3 -> alpha4
209 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
212 (AlgAlts [ ( FloatPrimAndIoWorld,
214 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
220 But, this is a completely different way of using @CCallOp@. The most
221 major changes required if we switch to this are in @primOpInfo@, and
222 the desugarer. The major difficulty is in moving the HeapRequirement
223 stuff somewhere appropriate. (The advantage is that we could simplify
224 @CCallOp@ and record just the number of arguments with corresponding
225 simplifications in reading pragma unfoldings, the simplifier,
226 instantiation (etc) of core expressions, ... . Maybe we should think
227 about using it this way?? ADR)
230 -- (... continued from above ... )
232 -- one to support "errorIO" (and, thereby, "error")
235 -- Operation to test two closure addresses for equality (yes really!)
236 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
237 | ReallyUnsafePtrEqualityOp
239 -- three for parallel stuff
244 -- two for concurrency
249 | ParGlobalOp -- named global par
250 | ParLocalOp -- named local par
251 | ParAtOp -- specifies destination of local par
252 | ParAtForNowOp -- specifies initial destination of global par
253 | CopyableOp -- marks copyable code
254 | NoFollowOp -- marks non-followup expression
258 Deriving Ix is what we really want! ToDo
259 (Chk around before deleting...)
261 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
262 tagOf_PrimOp CharGeOp = ILIT( 2)
263 tagOf_PrimOp CharEqOp = ILIT( 3)
264 tagOf_PrimOp CharNeOp = ILIT( 4)
265 tagOf_PrimOp CharLtOp = ILIT( 5)
266 tagOf_PrimOp CharLeOp = ILIT( 6)
267 tagOf_PrimOp IntGtOp = ILIT( 7)
268 tagOf_PrimOp IntGeOp = ILIT( 8)
269 tagOf_PrimOp IntEqOp = ILIT( 9)
270 tagOf_PrimOp IntNeOp = ILIT( 10)
271 tagOf_PrimOp IntLtOp = ILIT( 11)
272 tagOf_PrimOp IntLeOp = ILIT( 12)
273 tagOf_PrimOp WordGtOp = ILIT( 13)
274 tagOf_PrimOp WordGeOp = ILIT( 14)
275 tagOf_PrimOp WordEqOp = ILIT( 15)
276 tagOf_PrimOp WordNeOp = ILIT( 16)
277 tagOf_PrimOp WordLtOp = ILIT( 17)
278 tagOf_PrimOp WordLeOp = ILIT( 18)
279 tagOf_PrimOp AddrGtOp = ILIT( 19)
280 tagOf_PrimOp AddrGeOp = ILIT( 20)
281 tagOf_PrimOp AddrEqOp = ILIT( 21)
282 tagOf_PrimOp AddrNeOp = ILIT( 22)
283 tagOf_PrimOp AddrLtOp = ILIT( 23)
284 tagOf_PrimOp AddrLeOp = ILIT( 24)
285 tagOf_PrimOp FloatGtOp = ILIT( 25)
286 tagOf_PrimOp FloatGeOp = ILIT( 26)
287 tagOf_PrimOp FloatEqOp = ILIT( 27)
288 tagOf_PrimOp FloatNeOp = ILIT( 28)
289 tagOf_PrimOp FloatLtOp = ILIT( 29)
290 tagOf_PrimOp FloatLeOp = ILIT( 30)
291 tagOf_PrimOp DoubleGtOp = ILIT( 31)
292 tagOf_PrimOp DoubleGeOp = ILIT( 32)
293 tagOf_PrimOp DoubleEqOp = ILIT( 33)
294 tagOf_PrimOp DoubleNeOp = ILIT( 34)
295 tagOf_PrimOp DoubleLtOp = ILIT( 35)
296 tagOf_PrimOp DoubleLeOp = ILIT( 36)
297 tagOf_PrimOp OrdOp = ILIT( 37)
298 tagOf_PrimOp ChrOp = ILIT( 38)
299 tagOf_PrimOp IntAddOp = ILIT( 39)
300 tagOf_PrimOp IntSubOp = ILIT( 40)
301 tagOf_PrimOp IntMulOp = ILIT( 41)
302 tagOf_PrimOp IntQuotOp = ILIT( 42)
303 tagOf_PrimOp IntRemOp = ILIT( 44)
304 tagOf_PrimOp IntNegOp = ILIT( 45)
305 tagOf_PrimOp IntAbsOp = ILIT( 46)
306 tagOf_PrimOp AndOp = ILIT( 47)
307 tagOf_PrimOp OrOp = ILIT( 48)
308 tagOf_PrimOp NotOp = ILIT( 49)
309 tagOf_PrimOp SllOp = ILIT( 50)
310 tagOf_PrimOp SraOp = ILIT( 51)
311 tagOf_PrimOp SrlOp = ILIT( 52)
312 tagOf_PrimOp ISllOp = ILIT( 53)
313 tagOf_PrimOp ISraOp = ILIT( 54)
314 tagOf_PrimOp ISrlOp = ILIT( 55)
315 tagOf_PrimOp Int2WordOp = ILIT( 56)
316 tagOf_PrimOp Word2IntOp = ILIT( 57)
317 tagOf_PrimOp Int2AddrOp = ILIT( 58)
318 tagOf_PrimOp Addr2IntOp = ILIT( 59)
319 tagOf_PrimOp FloatAddOp = ILIT( 60)
320 tagOf_PrimOp FloatSubOp = ILIT( 61)
321 tagOf_PrimOp FloatMulOp = ILIT( 62)
322 tagOf_PrimOp FloatDivOp = ILIT( 63)
323 tagOf_PrimOp FloatNegOp = ILIT( 64)
324 tagOf_PrimOp Float2IntOp = ILIT( 65)
325 tagOf_PrimOp Int2FloatOp = ILIT( 66)
326 tagOf_PrimOp FloatExpOp = ILIT( 67)
327 tagOf_PrimOp FloatLogOp = ILIT( 68)
328 tagOf_PrimOp FloatSqrtOp = ILIT( 69)
329 tagOf_PrimOp FloatSinOp = ILIT( 70)
330 tagOf_PrimOp FloatCosOp = ILIT( 71)
331 tagOf_PrimOp FloatTanOp = ILIT( 72)
332 tagOf_PrimOp FloatAsinOp = ILIT( 73)
333 tagOf_PrimOp FloatAcosOp = ILIT( 74)
334 tagOf_PrimOp FloatAtanOp = ILIT( 75)
335 tagOf_PrimOp FloatSinhOp = ILIT( 76)
336 tagOf_PrimOp FloatCoshOp = ILIT( 77)
337 tagOf_PrimOp FloatTanhOp = ILIT( 78)
338 tagOf_PrimOp FloatPowerOp = ILIT( 79)
339 tagOf_PrimOp DoubleAddOp = ILIT( 80)
340 tagOf_PrimOp DoubleSubOp = ILIT( 81)
341 tagOf_PrimOp DoubleMulOp = ILIT( 82)
342 tagOf_PrimOp DoubleDivOp = ILIT( 83)
343 tagOf_PrimOp DoubleNegOp = ILIT( 84)
344 tagOf_PrimOp Double2IntOp = ILIT( 85)
345 tagOf_PrimOp Int2DoubleOp = ILIT( 86)
346 tagOf_PrimOp Double2FloatOp = ILIT( 87)
347 tagOf_PrimOp Float2DoubleOp = ILIT( 88)
348 tagOf_PrimOp DoubleExpOp = ILIT( 89)
349 tagOf_PrimOp DoubleLogOp = ILIT( 90)
350 tagOf_PrimOp DoubleSqrtOp = ILIT( 91)
351 tagOf_PrimOp DoubleSinOp = ILIT( 92)
352 tagOf_PrimOp DoubleCosOp = ILIT( 93)
353 tagOf_PrimOp DoubleTanOp = ILIT( 94)
354 tagOf_PrimOp DoubleAsinOp = ILIT( 95)
355 tagOf_PrimOp DoubleAcosOp = ILIT( 96)
356 tagOf_PrimOp DoubleAtanOp = ILIT( 97)
357 tagOf_PrimOp DoubleSinhOp = ILIT( 98)
358 tagOf_PrimOp DoubleCoshOp = ILIT( 99)
359 tagOf_PrimOp DoubleTanhOp = ILIT(100)
360 tagOf_PrimOp DoublePowerOp = ILIT(101)
361 tagOf_PrimOp IntegerAddOp = ILIT(102)
362 tagOf_PrimOp IntegerSubOp = ILIT(103)
363 tagOf_PrimOp IntegerMulOp = ILIT(104)
364 tagOf_PrimOp IntegerQuotRemOp = ILIT(105)
365 tagOf_PrimOp IntegerDivModOp = ILIT(106)
366 tagOf_PrimOp IntegerNegOp = ILIT(107)
367 tagOf_PrimOp IntegerCmpOp = ILIT(108)
368 tagOf_PrimOp Integer2IntOp = ILIT(109)
369 tagOf_PrimOp Int2IntegerOp = ILIT(110)
370 tagOf_PrimOp Word2IntegerOp = ILIT(111)
371 tagOf_PrimOp Addr2IntegerOp = ILIT(112)
372 tagOf_PrimOp FloatEncodeOp = ILIT(113)
373 tagOf_PrimOp FloatDecodeOp = ILIT(114)
374 tagOf_PrimOp DoubleEncodeOp = ILIT(115)
375 tagOf_PrimOp DoubleDecodeOp = ILIT(116)
376 tagOf_PrimOp NewArrayOp = ILIT(117)
377 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118)
378 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119)
379 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120)
380 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121)
381 tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122)
382 tagOf_PrimOp SameMutableArrayOp = ILIT(123)
383 tagOf_PrimOp SameMutableByteArrayOp = ILIT(124)
384 tagOf_PrimOp ReadArrayOp = ILIT(125)
385 tagOf_PrimOp WriteArrayOp = ILIT(126)
386 tagOf_PrimOp IndexArrayOp = ILIT(127)
387 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128)
388 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129)
389 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130)
390 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131)
391 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132)
392 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133)
393 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134)
394 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135)
395 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136)
396 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137)
397 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138)
398 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139)
399 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140)
400 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141)
401 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142)
402 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143)
403 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144)
404 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145)
405 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146)
406 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147)
407 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148)
408 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149)
409 tagOf_PrimOp NewSynchVarOp = ILIT(150)
410 tagOf_PrimOp TakeMVarOp = ILIT(151)
411 tagOf_PrimOp PutMVarOp = ILIT(152)
412 tagOf_PrimOp ReadIVarOp = ILIT(153)
413 tagOf_PrimOp WriteIVarOp = ILIT(154)
414 tagOf_PrimOp MakeStablePtrOp = ILIT(155)
415 tagOf_PrimOp DeRefStablePtrOp = ILIT(156)
416 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(157)
417 tagOf_PrimOp ErrorIOPrimOp = ILIT(158)
418 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(159)
419 tagOf_PrimOp SeqOp = ILIT(160)
420 tagOf_PrimOp ParOp = ILIT(161)
421 tagOf_PrimOp ForkOp = ILIT(162)
422 tagOf_PrimOp DelayOp = ILIT(163)
423 tagOf_PrimOp WaitOp = ILIT(164)
426 tagOf_PrimOp ParGlobalOp = ILIT(165)
427 tagOf_PrimOp ParLocalOp = ILIT(166)
428 tagOf_PrimOp ParAtOp = ILIT(167)
429 tagOf_PrimOp ParAtForNowOp = ILIT(168)
430 tagOf_PrimOp CopyableOp = ILIT(169)
431 tagOf_PrimOp NoFollowOp = ILIT(170)
434 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
436 instance Eq PrimOp where
437 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
440 An @Enum@-derived list would be better; meanwhile... (ToDo)
558 NewByteArrayOp CharRep,
559 NewByteArrayOp IntRep,
560 NewByteArrayOp AddrRep,
561 NewByteArrayOp FloatRep,
562 NewByteArrayOp DoubleRep,
564 SameMutableByteArrayOp,
568 ReadByteArrayOp CharRep,
569 ReadByteArrayOp IntRep,
570 ReadByteArrayOp AddrRep,
571 ReadByteArrayOp FloatRep,
572 ReadByteArrayOp DoubleRep,
573 WriteByteArrayOp CharRep,
574 WriteByteArrayOp IntRep,
575 WriteByteArrayOp AddrRep,
576 WriteByteArrayOp FloatRep,
577 WriteByteArrayOp DoubleRep,
578 IndexByteArrayOp CharRep,
579 IndexByteArrayOp IntRep,
580 IndexByteArrayOp AddrRep,
581 IndexByteArrayOp FloatRep,
582 IndexByteArrayOp DoubleRep,
583 IndexOffAddrOp CharRep,
584 IndexOffAddrOp IntRep,
585 IndexOffAddrOp AddrRep,
586 IndexOffAddrOp FloatRep,
587 IndexOffAddrOp DoubleRep,
589 UnsafeFreezeByteArrayOp,
598 ReallyUnsafePtrEqualityOp,
612 %************************************************************************
614 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
616 %************************************************************************
618 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
619 refer to the primitive operation. The conventional \tr{#}-for-
620 unboxed ops is added on later.
622 The reason for the funny characters in the names is so we do not
623 interfere with the programmer's Haskell name spaces.
625 We use @PrimKinds@ for the ``type'' information, because they're
626 (slightly) more convenient to use than @TyCons@.
629 = Dyadic FAST_STRING -- string :: T -> T -> T
631 | Monadic FAST_STRING -- string :: T -> T
633 | Compare FAST_STRING -- string :: T -> T -> Bool
635 | Coerce FAST_STRING -- string :: T1 -> T2
639 | PrimResult FAST_STRING
640 [TyVar] [Type] TyCon PrimRep [Type]
641 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
642 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
643 -- D# is a primitive type constructor.
644 -- (the kind is the same info as D#, in another convenient form)
646 | AlgResult FAST_STRING
647 [TyVar] [Type] TyCon [Type]
648 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
649 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
651 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
656 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
658 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
659 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
660 an_Integer_and_Int_tys
661 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
664 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
666 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
668 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
670 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
673 @primOpInfo@ gives all essential information (from which everything
674 else, notably a type, can be constructed) for each @PrimOp@.
677 primOpInfo :: PrimOp -> PrimOpInfo
680 There's plenty of this stuff!
682 %************************************************************************
684 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
686 %************************************************************************
689 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
690 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
691 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
692 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
693 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
694 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
696 primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy
697 primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy
698 primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy
699 primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy
700 primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy
701 primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy
703 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
704 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
705 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
706 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
707 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
708 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
710 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
711 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
712 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
713 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
714 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
715 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
717 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
718 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
719 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
720 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
721 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
722 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
724 primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
725 primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
726 primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
727 primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
728 primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
729 primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
732 %************************************************************************
734 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
736 %************************************************************************
739 primOpInfo OrdOp = Coerce SLIT("ord#") charPrimTy intPrimTy
740 primOpInfo ChrOp = Coerce SLIT("chr#") intPrimTy charPrimTy
743 %************************************************************************
745 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
747 %************************************************************************
750 primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy
751 primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy
752 primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy
753 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
754 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
756 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
759 %************************************************************************
761 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
763 %************************************************************************
765 A @Word#@ is an unsigned @Int#@.
768 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
769 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
770 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
773 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
775 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
777 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
780 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
782 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
784 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
786 primOpInfo Int2WordOp = Coerce SLIT("int2Word#") intPrimTy wordPrimTy
787 primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy
790 %************************************************************************
792 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
794 %************************************************************************
797 primOpInfo Int2AddrOp = Coerce SLIT("int2Addr#") intPrimTy addrPrimTy
798 primOpInfo Addr2IntOp = Coerce SLIT("addr2Int#") addrPrimTy intPrimTy
801 %************************************************************************
803 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
805 %************************************************************************
807 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
811 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
812 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
813 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
814 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
815 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
817 primOpInfo Float2IntOp = Coerce SLIT("float2Int#") floatPrimTy intPrimTy
818 primOpInfo Int2FloatOp = Coerce SLIT("int2Float#") intPrimTy floatPrimTy
820 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
821 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
822 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
823 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
824 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
825 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
826 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
827 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
828 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
829 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
830 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
831 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
832 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
835 %************************************************************************
837 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
839 %************************************************************************
841 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
845 primOpInfo DoubleAddOp = Dyadic SLIT("plusDouble#") doublePrimTy
846 primOpInfo DoubleSubOp = Dyadic SLIT("minusDouble#") doublePrimTy
847 primOpInfo DoubleMulOp = Dyadic SLIT("timesDouble#") doublePrimTy
848 primOpInfo DoubleDivOp = Dyadic SLIT("divideDouble#") doublePrimTy
849 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
851 primOpInfo Double2IntOp = Coerce SLIT("double2Int#") doublePrimTy intPrimTy
852 primOpInfo Int2DoubleOp = Coerce SLIT("int2Double#") intPrimTy doublePrimTy
854 primOpInfo Double2FloatOp = Coerce SLIT("double2Float#") doublePrimTy floatPrimTy
855 primOpInfo Float2DoubleOp = Coerce SLIT("float2Double#") floatPrimTy doublePrimTy
857 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
858 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
859 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
860 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
861 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
862 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
863 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
864 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
865 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
866 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
867 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
868 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
869 primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy
872 %************************************************************************
874 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
876 %************************************************************************
879 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
881 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
882 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
883 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
885 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
887 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
888 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
890 primOpInfo Integer2IntOp
891 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
893 primOpInfo Int2IntegerOp
894 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
896 primOpInfo Word2IntegerOp
897 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
899 primOpInfo Addr2IntegerOp
900 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
903 Encoding and decoding of floating-point numbers is sorta
907 primOpInfo FloatEncodeOp
908 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
909 floatPrimTyCon FloatRep []
911 primOpInfo DoubleEncodeOp
912 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
913 doublePrimTyCon DoubleRep []
915 primOpInfo FloatDecodeOp
916 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
918 primOpInfo DoubleDecodeOp
919 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
922 %************************************************************************
924 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
926 %************************************************************************
929 primOpInfo NewArrayOp
931 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
933 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
934 stateAndMutableArrayPrimTyCon [s, elt]
936 primOpInfo (NewByteArrayOp kind)
938 s = alphaTy; s_tv = alphaTyVar
940 (str, _, prim_tycon) = getPrimRepInfo kind
942 op_str = _PK_ ("new" ++ str ++ "Array#")
944 AlgResult op_str [s_tv]
945 [intPrimTy, mkStatePrimTy s]
946 stateAndMutableByteArrayPrimTyCon [s]
948 ---------------------------------------------------------------------------
950 primOpInfo SameMutableArrayOp
952 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
953 mut_arr_ty = mkMutableArrayPrimTy s elt
955 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
958 primOpInfo SameMutableByteArrayOp
960 s = alphaTy; s_tv = alphaTyVar;
961 mut_arr_ty = mkMutableByteArrayPrimTy s
963 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
966 ---------------------------------------------------------------------------
967 -- Primitive arrays of Haskell pointers:
969 primOpInfo ReadArrayOp
971 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
973 AlgResult SLIT("readArray#") [s_tv, elt_tv]
974 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
975 stateAndPtrPrimTyCon [s, elt]
978 primOpInfo WriteArrayOp
980 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
982 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
983 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
984 statePrimTyCon VoidRep [s]
986 primOpInfo IndexArrayOp
987 = let { elt = alphaTy; elt_tv = alphaTyVar } in
988 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
991 ---------------------------------------------------------------------------
992 -- Primitive arrays full of unboxed bytes:
994 primOpInfo (ReadByteArrayOp kind)
996 s = alphaTy; s_tv = alphaTyVar
998 (str, _, prim_tycon) = getPrimRepInfo kind
1000 op_str = _PK_ ("read" ++ str ++ "Array#")
1001 relevant_tycon = assoc "primOpInfo" tbl kind
1003 AlgResult op_str [s_tv]
1004 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1007 tbl = [ (CharRep, stateAndCharPrimTyCon),
1008 (IntRep, stateAndIntPrimTyCon),
1009 (AddrRep, stateAndAddrPrimTyCon),
1010 (FloatRep, stateAndFloatPrimTyCon),
1011 (DoubleRep, stateAndDoublePrimTyCon) ]
1013 -- How come there's no Word byte arrays? ADR
1015 primOpInfo (WriteByteArrayOp kind)
1017 s = alphaTy; s_tv = alphaTyVar
1019 (str, prim_ty, _) = getPrimRepInfo kind
1020 op_str = _PK_ ("write" ++ str ++ "Array#")
1022 -- NB: *Prim*Result --
1023 PrimResult op_str [s_tv]
1024 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1025 statePrimTyCon VoidRep [s]
1027 primOpInfo (IndexByteArrayOp kind)
1029 (str, _, prim_tycon) = getPrimRepInfo kind
1030 op_str = _PK_ ("index" ++ str ++ "Array#")
1032 -- NB: *Prim*Result --
1033 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1035 primOpInfo (IndexOffAddrOp kind)
1037 (str, _, prim_tycon) = getPrimRepInfo kind
1038 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1040 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1042 ---------------------------------------------------------------------------
1043 primOpInfo UnsafeFreezeArrayOp
1045 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1047 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1048 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1049 stateAndArrayPrimTyCon [s, elt]
1051 primOpInfo UnsafeFreezeByteArrayOp
1052 = let { s = alphaTy; s_tv = alphaTyVar } in
1053 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1054 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1055 stateAndByteArrayPrimTyCon [s]
1058 %************************************************************************
1060 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1062 %************************************************************************
1065 primOpInfo NewSynchVarOp
1067 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1069 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1070 stateAndSynchVarPrimTyCon [s, elt]
1072 primOpInfo TakeMVarOp
1074 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1076 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1077 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1078 stateAndPtrPrimTyCon [s, elt]
1080 primOpInfo PutMVarOp
1082 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1084 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1085 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1088 primOpInfo ReadIVarOp
1090 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1092 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1093 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1094 stateAndPtrPrimTyCon [s, elt]
1096 primOpInfo WriteIVarOp
1098 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1100 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1101 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1106 %************************************************************************
1108 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1110 %************************************************************************
1116 s = alphaTy; s_tv = alphaTyVar
1118 PrimResult SLIT("delay#") [s_tv]
1119 [intPrimTy, mkStatePrimTy s]
1120 statePrimTyCon VoidRep [s]
1124 s = alphaTy; s_tv = alphaTyVar
1126 PrimResult SLIT("wait#") [s_tv]
1127 [intPrimTy, mkStatePrimTy s]
1128 statePrimTyCon VoidRep [s]
1133 %************************************************************************
1135 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1137 %************************************************************************
1139 A {\em stable pointer} is an index into a table of pointers into the
1140 heap. Since the garbage collector is told about stable pointers, it
1141 is safe to pass a stable pointer to external systems such as C
1144 Here's what the operations and types are supposed to be (from
1145 state-interface document).
1148 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1149 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1150 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1153 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1154 operation since it doesn't (directly) involve IO operations. The
1155 reason is that if some optimisation pass decided to duplicate calls to
1156 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1157 massive space leak can result. Putting it into the PrimIO monad
1158 prevents this. (Another reason for putting them in a monad is to
1159 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1162 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1163 besides, it's not likely to be used from Haskell) so it's not a
1166 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1169 primOpInfo MakeStablePtrOp
1170 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1171 [alphaTy, realWorldStatePrimTy]
1172 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1174 primOpInfo DeRefStablePtrOp
1175 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1176 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1177 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1180 %************************************************************************
1182 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1184 %************************************************************************
1186 [Alastair Reid is to blame for this!]
1188 These days, (Glasgow) Haskell seems to have a bit of everything from
1189 other languages: strict operations, mutable variables, sequencing,
1190 pointers, etc. About the only thing left is LISP's ability to test
1191 for pointer equality. So, let's add it in!
1194 reallyUnsafePtrEquality :: a -> a -> Int#
1197 which tests any two closures (of the same type) to see if they're the
1198 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1199 difficulties of trying to box up the result.)
1201 NB This is {\em really unsafe\/} because even something as trivial as
1202 a garbage collection might change the answer by removing indirections.
1203 Still, no-one's forcing you to use it. If you're worried about little
1204 things like loss of referential transparency, you might like to wrap
1205 it all up in a monad-like thing as John O'Donnell and John Hughes did
1206 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1209 I'm thinking of using it to speed up a critical equality test in some
1210 graphics stuff in a context where the possibility of saying that
1211 denotationally equal things aren't isn't a problem (as long as it
1212 doesn't happen too often.) ADR
1214 To Will: Jim said this was already in, but I can't see it so I'm
1215 adding it. Up to you whether you add it. (Note that this could have
1216 been readily implemented using a @veryDangerousCCall@ before they were
1220 primOpInfo ReallyUnsafePtrEqualityOp
1221 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1222 [alphaTy, alphaTy] intPrimTyCon IntRep []
1225 %************************************************************************
1227 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1229 %************************************************************************
1232 primOpInfo SeqOp -- seq# :: a -> Int#
1233 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1235 primOpInfo ParOp -- par# :: a -> Int#
1236 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1238 primOpInfo ForkOp -- fork# :: a -> Int#
1239 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1246 primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b
1247 = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1249 primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b
1250 = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy]
1252 primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c
1253 = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1255 primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c
1256 = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy]
1258 primOpInfo CopyableOp -- copyable# :: a -> a
1259 = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1261 primOpInfo NoFollowOp -- noFollow# :: a -> a
1262 = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy]
1267 %************************************************************************
1269 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1271 %************************************************************************
1274 primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
1275 = PrimResult SLIT("errorIO#") []
1277 statePrimTyCon VoidRep [realWorldTy]
1280 %************************************************************************
1282 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1284 %************************************************************************
1287 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1288 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1290 (result_tycon, tys_applied, _) = getAppDataTyCon result_ty
1293 %************************************************************************
1295 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1297 %************************************************************************
1299 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1300 with @Integers@ can trigger GC. Here we describe the heap requirements
1301 of the various @PrimOps@. For most, no heap is required. For a few,
1302 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1303 be combined with the rest of the heap usage in the basic block. For an
1304 unfortunate few, some unknown amount of heap is required (these are the
1305 ops which can trigger GC).
1309 data HeapRequirement
1311 | FixedHeapRequired HeapOffset
1312 | VariableHeapRequired
1314 primOpHeapReq :: PrimOp -> HeapRequirement
1316 primOpHeapReq NewArrayOp = VariableHeapRequired
1317 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1319 primOpHeapReq IntegerAddOp = VariableHeapRequired
1320 primOpHeapReq IntegerSubOp = VariableHeapRequired
1321 primOpHeapReq IntegerMulOp = VariableHeapRequired
1322 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1323 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1324 primOpHeapReq IntegerNegOp = VariableHeapRequired
1325 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1326 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1327 (intOff mIN_MP_INT_SIZE))
1328 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1329 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1330 (intOff mIN_MP_INT_SIZE))
1331 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1332 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1333 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1334 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1335 (intOff mIN_MP_INT_SIZE)))
1336 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1337 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1338 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1339 (intOff mIN_MP_INT_SIZE)))
1341 -- ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1342 -- or if it returns a MallocPtr.
1344 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1345 primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty)
1346 = if returnsMallocPtr
1347 then VariableHeapRequired
1351 = case (maybeAppDataTyCon return_ty) of
1353 Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon
1355 -- this occasionally has to expand the Stable Pointer table
1356 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1358 -- These four only need heap space with the native code generator
1359 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1361 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1362 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1363 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1364 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1366 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1367 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1368 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1370 -- Sparking ops no longer allocate any heap; however, _fork_ may
1371 -- require a context switch to clear space in the required thread
1372 -- pool, and that requires liveness information.
1374 primOpHeapReq ParOp = NoHeapRequired
1375 primOpHeapReq ForkOp = VariableHeapRequired
1377 -- A SeqOp requires unknown space to evaluate its argument
1378 primOpHeapReq SeqOp = VariableHeapRequired
1382 -- a ParGlobalOp creates a single 4-tuple in the heap. ToDo: verify this!
1383 primOpHeapReq ParGlobalOp = trace "primOpHeapReq:ParGlobalOp:verify!" (
1385 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1388 -- a ParLocalOp creates a single 4-tuple in the heap. ToDo: verify this!
1389 primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" (
1391 (addOff (totHdrSize (MuTupleRep 4)) (intOff 4))
1394 -- ToDo: parAt, parAtForNow, copyable, noFollow !! (HWL)
1397 primOpHeapReq other_op = NoHeapRequired
1401 Primops which can trigger GC have to be called carefully.
1402 In particular, their arguments are guaranteed to be in registers,
1403 and a liveness mask tells which regs are live.
1407 primOpCanTriggerGC op =
1414 case primOpHeapReq op of
1415 VariableHeapRequired -> True
1420 Sometimes we may choose to execute a PrimOp even though it isn't
1421 certain that its result will be required; ie execute them
1422 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1423 this is OK, because PrimOps are usually cheap, but it isn't OK for
1424 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1426 See also @primOpIsCheap@ (below).
1428 There should be no worries about side effects; that's all taken care
1429 of by data dependencies.
1433 primOpOkForSpeculation :: PrimOp -> Bool
1436 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1437 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1440 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1441 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1443 -- Float. ToDo: tan? tanh?
1444 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1445 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1446 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1447 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1449 -- Double. ToDo: tan? tanh?
1450 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1451 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1452 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1453 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1456 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1459 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1462 primOpOkForSpeculation ParOp = False -- Could be expensive!
1463 primOpOkForSpeculation ForkOp = False -- Likewise
1464 primOpOkForSpeculation SeqOp = False -- Likewise
1467 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1468 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1471 -- The default is "yes it's ok for speculation"
1472 primOpOkForSpeculation other_op = True
1476 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1477 WARNING), we just borrow some other predicates for a
1478 what-should-be-good-enough test.
1482 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1486 And some primops have side-effects and so, for example, must not be
1491 fragilePrimOp :: PrimOp -> Bool
1493 fragilePrimOp ParOp = True
1494 fragilePrimOp ForkOp = True
1495 fragilePrimOp SeqOp = True
1496 fragilePrimOp MakeStablePtrOp = True
1497 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1500 fragilePrimOp ParGlobalOp = True
1501 fragilePrimOp ParLocalOp = True
1502 fragilePrimOp CopyableOp = trace "fragilePrimOp:CopyableOp" True -- Possibly not. ASP
1503 fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly not. ASP
1506 fragilePrimOp other = False
1510 Primitive operations that perform calls need wrappers to save any live variables
1511 that are stored in caller-saves registers
1515 primOpNeedsWrapper :: PrimOp -> Bool
1517 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1519 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1520 primOpNeedsWrapper (NewByteArrayOp _) = True
1522 primOpNeedsWrapper IntegerAddOp = True
1523 primOpNeedsWrapper IntegerSubOp = True
1524 primOpNeedsWrapper IntegerMulOp = True
1525 primOpNeedsWrapper IntegerQuotRemOp = True
1526 primOpNeedsWrapper IntegerDivModOp = True
1527 primOpNeedsWrapper IntegerNegOp = True
1528 primOpNeedsWrapper IntegerCmpOp = True
1529 primOpNeedsWrapper Integer2IntOp = True
1530 primOpNeedsWrapper Int2IntegerOp = True
1531 primOpNeedsWrapper Word2IntegerOp = True
1532 primOpNeedsWrapper Addr2IntegerOp = True
1534 primOpNeedsWrapper FloatExpOp = True
1535 primOpNeedsWrapper FloatLogOp = True
1536 primOpNeedsWrapper FloatSqrtOp = True
1537 primOpNeedsWrapper FloatSinOp = True
1538 primOpNeedsWrapper FloatCosOp = True
1539 primOpNeedsWrapper FloatTanOp = True
1540 primOpNeedsWrapper FloatAsinOp = True
1541 primOpNeedsWrapper FloatAcosOp = True
1542 primOpNeedsWrapper FloatAtanOp = True
1543 primOpNeedsWrapper FloatSinhOp = True
1544 primOpNeedsWrapper FloatCoshOp = True
1545 primOpNeedsWrapper FloatTanhOp = True
1546 primOpNeedsWrapper FloatPowerOp = True
1547 primOpNeedsWrapper FloatEncodeOp = True
1548 primOpNeedsWrapper FloatDecodeOp = True
1550 primOpNeedsWrapper DoubleExpOp = True
1551 primOpNeedsWrapper DoubleLogOp = True
1552 primOpNeedsWrapper DoubleSqrtOp = True
1553 primOpNeedsWrapper DoubleSinOp = True
1554 primOpNeedsWrapper DoubleCosOp = True
1555 primOpNeedsWrapper DoubleTanOp = True
1556 primOpNeedsWrapper DoubleAsinOp = True
1557 primOpNeedsWrapper DoubleAcosOp = True
1558 primOpNeedsWrapper DoubleAtanOp = True
1559 primOpNeedsWrapper DoubleSinhOp = True
1560 primOpNeedsWrapper DoubleCoshOp = True
1561 primOpNeedsWrapper DoubleTanhOp = True
1562 primOpNeedsWrapper DoublePowerOp = True
1563 primOpNeedsWrapper DoubleEncodeOp = True
1564 primOpNeedsWrapper DoubleDecodeOp = True
1566 primOpNeedsWrapper MakeStablePtrOp = True
1567 primOpNeedsWrapper DeRefStablePtrOp = True
1569 primOpNeedsWrapper TakeMVarOp = True
1570 primOpNeedsWrapper PutMVarOp = True
1571 primOpNeedsWrapper ReadIVarOp = True
1573 primOpNeedsWrapper DelayOp = True
1574 primOpNeedsWrapper WaitOp = True
1576 primOpNeedsWrapper other_op = False
1582 = case (primOpInfo op) of
1584 Monadic str _ -> str
1585 Compare str _ -> str
1586 Coerce str _ _ -> str
1587 PrimResult str _ _ _ _ _ -> str
1588 AlgResult str _ _ _ _ -> str
1591 @primOpType@ duplicates some work of @primOpId@, but since we
1592 grab types pretty often...
1594 primOpType :: PrimOp -> Type
1597 = case (primOpInfo op) of
1598 Dyadic str ty -> dyadic_fun_ty ty
1599 Monadic str ty -> monadic_fun_ty ty
1600 Compare str ty -> compare_fun_ty ty
1601 Coerce str ty1 ty2 -> mkFunTys [ty1] ty2
1603 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1604 mkForAllTys tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys))
1606 AlgResult str tyvars arg_tys tycon res_tys ->
1607 mkForAllTys tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys))
1611 data PrimOpResultInfo
1612 = ReturnsPrim PrimRep
1615 -- ToDo: Deal with specialised PrimOps
1616 -- Will need to return specialised tycon and data constructors
1618 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1620 getPrimOpResultInfo op
1621 = case (primOpInfo op) of
1622 Dyadic _ ty -> ReturnsPrim (primRepFromType ty)
1623 Monadic _ ty -> ReturnsPrim (primRepFromType ty)
1624 Compare _ ty -> ReturnsAlg boolTyCon
1625 Coerce _ _ ty -> ReturnsPrim (primRepFromType ty)
1626 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1627 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1629 isCompareOp :: PrimOp -> Bool
1632 = case primOpInfo op of
1639 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1640 monadic_fun_ty ty = mkFunTys [ty] ty
1641 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1646 pprPrimOp :: PprStyle -> PrimOp -> Pretty
1647 showPrimOp :: PprStyle -> PrimOp -> String
1650 = ppShow 1000{-random-} (pprPrimOp sty op)
1652 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1656 if may_gc then "(_casm_GC_ ``" else "(_casm_ ``"
1658 if may_gc then "(_ccall_GC_ " else "(_ccall_ "
1661 = if is_casm then ppStr "''" else ppNil
1664 = ppBesides [ppStr " { [",
1665 ppIntersperse pp'SP{-'-} (map (pprParendType sty) arg_tys),
1666 ppRbrack, ppSP, pprParendType sty res_ty, ppStr " })"]
1669 ppBesides [ppStr before, ppPStr fun, after, pp_tys]
1671 pprPrimOp sty other_op
1673 str = primOp_str other_op
1679 instance Outputable PrimOp where
1680 ppr sty op = pprPrimOp sty op