2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrimOp]{Primitive operations (machine-level)}
8 PrimOp(..), allThePrimOps,
9 tagOf_PrimOp, -- ToDo: rm
11 primOpType, isCompareOp,
17 primOpCanTriggerGC, primOpNeedsWrapper,
18 primOpOkForSpeculation, primOpIsCheap,
20 HeapRequirement(..), primOpHeapReq,
21 StackRequirement(..), primOpStackRequired,
23 -- export for the Native Code Generator
24 primOpInfo, -- needed for primOpNameInfo
30 #include "HsVersions.h"
32 import PrimRep -- most of it
36 import CStrings ( identToC )
37 import CallConv ( CallConv, pprCallConv )
38 import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
39 import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
41 import PprType ( pprParendType )
42 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
43 import TyCon ( TyCon{-instances-} )
44 import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp, typePrimRep,
45 splitAlgTyConApp, Type
47 import TyVar --( alphaTyVar, betaTyVar, gammaTyVar )
48 import Unique ( Unique{-instance Eq-} )
49 import Util ( panic#, assoc, panic{-ToDo:rm-} )
51 import GlaExts ( Int(..), Int#, (==#) )
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
82 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
85 | WordQuotOp | WordRemOp
86 | AndOp | OrOp | NotOp | XorOp
87 | SllOp | SrlOp -- shift {left,right} {logical}
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 | Integer2WordOp
126 | Int2IntegerOp | Word2IntegerOp
127 | Addr2IntegerOp -- "Addr" is *always* a literal string
128 -- casting to/from Integer and 64-bit (un)signed quantities.
129 | IntegerToInt64Op | Int64ToIntegerOp
130 | IntegerToWord64Op | Word64ToIntegerOp
133 | FloatEncodeOp | FloatDecodeOp
134 | DoubleEncodeOp | DoubleDecodeOp
136 -- primitive ops for primitive arrays
139 | NewByteArrayOp PrimRep
142 | SameMutableByteArrayOp
144 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
146 | ReadByteArrayOp PrimRep
147 | WriteByteArrayOp PrimRep
148 | IndexByteArrayOp PrimRep
149 | IndexOffAddrOp PrimRep
150 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
151 -- This is just a cheesy encoding of a bunch of ops.
152 -- Note that ForeignObjRep is not included -- the only way of
153 -- creating a ForeignObj is with a ccall or casm.
154 | IndexOffForeignObjOp PrimRep
155 | WriteOffAddrOp PrimRep
157 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
158 | SizeofByteArrayOp | SizeofMutableByteArrayOp
160 | NewSynchVarOp -- for MVars and IVars
162 | TakeMVarOp | PutMVarOp
163 | ReadIVarOp | WriteIVarOp
165 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
166 | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
167 | MakeStablePtrOp | DeRefStablePtrOp
170 A special ``trap-door'' to use in making calls direct to C functions:
173 FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
174 Unique) -- Right u => first argument (an Addr#) is the function pointer
175 -- (unique is used to
178 Bool -- True <=> really a "casm"
179 Bool -- True <=> might invoke Haskell GC
180 CallConv -- calling convention to use.
181 [Type] -- Unboxed arguments; the state-token
182 -- argument will have been put *first*
183 Type -- Return type; one of the "StateAnd<blah>#" types
185 -- (... to be continued ... )
188 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
189 (See @primOpInfo@ for details.)
191 Note: that first arg and part of the result should be the system state
192 token (which we carry around to fool over-zealous optimisers) but
193 which isn't actually passed.
195 For example, we represent
197 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
203 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
204 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
208 (AlgAlts [ ( FloatPrimAndIoWorld,
210 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
216 Nota Bene: there are some people who find the empty list of types in
217 the @Prim@ somewhat puzzling and would represent the above by
221 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
222 -- :: /\ alpha1, alpha2 alpha3, alpha4.
223 -- alpha1 -> alpha2 -> alpha3 -> alpha4
224 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
227 (AlgAlts [ ( FloatPrimAndIoWorld,
229 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
235 But, this is a completely different way of using @CCallOp@. The most
236 major changes required if we switch to this are in @primOpInfo@, and
237 the desugarer. The major difficulty is in moving the HeapRequirement
238 stuff somewhere appropriate. (The advantage is that we could simplify
239 @CCallOp@ and record just the number of arguments with corresponding
240 simplifications in reading pragma unfoldings, the simplifier,
241 instantiation (etc) of core expressions, ... . Maybe we should think
242 about using it this way?? ADR)
245 -- (... continued from above ... )
247 -- one to support "errorIO" (and, thereby, "error")
250 -- Operation to test two closure addresses for equality (yes really!)
251 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
252 | ReallyUnsafePtrEqualityOp
254 -- three for parallel stuff
259 -- three for concurrency
264 | ParGlobalOp -- named global par
265 | ParLocalOp -- named local par
266 | ParAtOp -- specifies destination of local par
267 | ParAtAbsOp -- specifies destination of local par (abs processor)
268 | ParAtRelOp -- specifies destination of local par (rel processor)
269 | ParAtForNowOp -- specifies initial destination of global par
270 | CopyableOp -- marks copyable code
271 | NoFollowOp -- marks non-followup expression
275 Deriving Ix is what we really want! ToDo
276 (Chk around before deleting...)
278 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
279 tagOf_PrimOp CharGeOp = ILIT( 2)
280 tagOf_PrimOp CharEqOp = ILIT( 3)
281 tagOf_PrimOp CharNeOp = ILIT( 4)
282 tagOf_PrimOp CharLtOp = ILIT( 5)
283 tagOf_PrimOp CharLeOp = ILIT( 6)
284 tagOf_PrimOp IntGtOp = ILIT( 7)
285 tagOf_PrimOp IntGeOp = ILIT( 8)
286 tagOf_PrimOp IntEqOp = ILIT( 9)
287 tagOf_PrimOp IntNeOp = ILIT( 10)
288 tagOf_PrimOp IntLtOp = ILIT( 11)
289 tagOf_PrimOp IntLeOp = ILIT( 12)
290 tagOf_PrimOp WordGtOp = ILIT( 13)
291 tagOf_PrimOp WordGeOp = ILIT( 14)
292 tagOf_PrimOp WordEqOp = ILIT( 15)
293 tagOf_PrimOp WordNeOp = ILIT( 16)
294 tagOf_PrimOp WordLtOp = ILIT( 17)
295 tagOf_PrimOp WordLeOp = ILIT( 18)
296 tagOf_PrimOp AddrGtOp = ILIT( 19)
297 tagOf_PrimOp AddrGeOp = ILIT( 20)
298 tagOf_PrimOp AddrEqOp = ILIT( 21)
299 tagOf_PrimOp AddrNeOp = ILIT( 22)
300 tagOf_PrimOp AddrLtOp = ILIT( 23)
301 tagOf_PrimOp AddrLeOp = ILIT( 24)
302 tagOf_PrimOp FloatGtOp = ILIT( 25)
303 tagOf_PrimOp FloatGeOp = ILIT( 26)
304 tagOf_PrimOp FloatEqOp = ILIT( 27)
305 tagOf_PrimOp FloatNeOp = ILIT( 28)
306 tagOf_PrimOp FloatLtOp = ILIT( 29)
307 tagOf_PrimOp FloatLeOp = ILIT( 30)
308 tagOf_PrimOp DoubleGtOp = ILIT( 31)
309 tagOf_PrimOp DoubleGeOp = ILIT( 32)
310 tagOf_PrimOp DoubleEqOp = ILIT( 33)
311 tagOf_PrimOp DoubleNeOp = ILIT( 34)
312 tagOf_PrimOp DoubleLtOp = ILIT( 35)
313 tagOf_PrimOp DoubleLeOp = ILIT( 36)
314 tagOf_PrimOp OrdOp = ILIT( 37)
315 tagOf_PrimOp ChrOp = ILIT( 38)
316 tagOf_PrimOp IntAddOp = ILIT( 39)
317 tagOf_PrimOp IntSubOp = ILIT( 40)
318 tagOf_PrimOp IntMulOp = ILIT( 41)
319 tagOf_PrimOp IntQuotOp = ILIT( 42)
320 tagOf_PrimOp IntRemOp = ILIT( 43)
321 tagOf_PrimOp IntNegOp = ILIT( 44)
322 tagOf_PrimOp IntAbsOp = ILIT( 45)
323 tagOf_PrimOp WordQuotOp = ILIT( 46)
324 tagOf_PrimOp WordRemOp = ILIT( 47)
325 tagOf_PrimOp AndOp = ILIT( 48)
326 tagOf_PrimOp OrOp = ILIT( 49)
327 tagOf_PrimOp NotOp = ILIT( 50)
328 tagOf_PrimOp XorOp = ILIT( 51)
329 tagOf_PrimOp SllOp = ILIT( 52)
330 tagOf_PrimOp SrlOp = ILIT( 53)
331 tagOf_PrimOp ISllOp = ILIT( 54)
332 tagOf_PrimOp ISraOp = ILIT( 55)
333 tagOf_PrimOp ISrlOp = ILIT( 56)
334 tagOf_PrimOp Int2WordOp = ILIT( 57)
335 tagOf_PrimOp Word2IntOp = ILIT( 58)
336 tagOf_PrimOp Int2AddrOp = ILIT( 59)
337 tagOf_PrimOp Addr2IntOp = ILIT( 60)
339 tagOf_PrimOp FloatAddOp = ILIT( 61)
340 tagOf_PrimOp FloatSubOp = ILIT( 62)
341 tagOf_PrimOp FloatMulOp = ILIT( 63)
342 tagOf_PrimOp FloatDivOp = ILIT( 64)
343 tagOf_PrimOp FloatNegOp = ILIT( 65)
344 tagOf_PrimOp Float2IntOp = ILIT( 66)
345 tagOf_PrimOp Int2FloatOp = ILIT( 67)
346 tagOf_PrimOp FloatExpOp = ILIT( 68)
347 tagOf_PrimOp FloatLogOp = ILIT( 69)
348 tagOf_PrimOp FloatSqrtOp = ILIT( 70)
349 tagOf_PrimOp FloatSinOp = ILIT( 71)
350 tagOf_PrimOp FloatCosOp = ILIT( 72)
351 tagOf_PrimOp FloatTanOp = ILIT( 73)
352 tagOf_PrimOp FloatAsinOp = ILIT( 74)
353 tagOf_PrimOp FloatAcosOp = ILIT( 75)
354 tagOf_PrimOp FloatAtanOp = ILIT( 76)
355 tagOf_PrimOp FloatSinhOp = ILIT( 77)
356 tagOf_PrimOp FloatCoshOp = ILIT( 78)
357 tagOf_PrimOp FloatTanhOp = ILIT( 79)
358 tagOf_PrimOp FloatPowerOp = ILIT( 80)
359 tagOf_PrimOp DoubleAddOp = ILIT( 81)
360 tagOf_PrimOp DoubleSubOp = ILIT( 82)
361 tagOf_PrimOp DoubleMulOp = ILIT( 83)
362 tagOf_PrimOp DoubleDivOp = ILIT( 84)
363 tagOf_PrimOp DoubleNegOp = ILIT( 85)
364 tagOf_PrimOp Double2IntOp = ILIT( 86)
365 tagOf_PrimOp Int2DoubleOp = ILIT( 87)
366 tagOf_PrimOp Double2FloatOp = ILIT( 88)
367 tagOf_PrimOp Float2DoubleOp = ILIT( 89)
368 tagOf_PrimOp DoubleExpOp = ILIT( 90)
369 tagOf_PrimOp DoubleLogOp = ILIT( 91)
370 tagOf_PrimOp DoubleSqrtOp = ILIT( 92)
371 tagOf_PrimOp DoubleSinOp = ILIT( 93)
372 tagOf_PrimOp DoubleCosOp = ILIT( 94)
373 tagOf_PrimOp DoubleTanOp = ILIT( 95)
374 tagOf_PrimOp DoubleAsinOp = ILIT( 96)
375 tagOf_PrimOp DoubleAcosOp = ILIT( 97)
376 tagOf_PrimOp DoubleAtanOp = ILIT( 98)
377 tagOf_PrimOp DoubleSinhOp = ILIT( 99)
378 tagOf_PrimOp DoubleCoshOp = ILIT(100)
379 tagOf_PrimOp DoubleTanhOp = ILIT(101)
380 tagOf_PrimOp DoublePowerOp = ILIT(102)
381 tagOf_PrimOp IntegerAddOp = ILIT(103)
382 tagOf_PrimOp IntegerSubOp = ILIT(104)
383 tagOf_PrimOp IntegerMulOp = ILIT(105)
384 tagOf_PrimOp IntegerQuotRemOp = ILIT(106)
385 tagOf_PrimOp IntegerDivModOp = ILIT(107)
386 tagOf_PrimOp IntegerNegOp = ILIT(108)
387 tagOf_PrimOp IntegerCmpOp = ILIT(109)
388 tagOf_PrimOp Integer2IntOp = ILIT(110)
389 tagOf_PrimOp Integer2WordOp = ILIT(111)
390 tagOf_PrimOp Int2IntegerOp = ILIT(112)
391 tagOf_PrimOp Word2IntegerOp = ILIT(113)
392 tagOf_PrimOp Addr2IntegerOp = ILIT(114)
393 tagOf_PrimOp IntegerToInt64Op = ILIT(115)
394 tagOf_PrimOp Int64ToIntegerOp = ILIT(116)
395 tagOf_PrimOp IntegerToWord64Op = ILIT(117)
396 tagOf_PrimOp Word64ToIntegerOp = ILIT(118)
397 tagOf_PrimOp FloatEncodeOp = ILIT(119)
398 tagOf_PrimOp FloatDecodeOp = ILIT(120)
399 tagOf_PrimOp DoubleEncodeOp = ILIT(121)
400 tagOf_PrimOp DoubleDecodeOp = ILIT(122)
401 tagOf_PrimOp NewArrayOp = ILIT(123)
402 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(124)
403 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(125)
404 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(126)
405 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(127)
406 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(128)
407 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(129)
408 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(130)
409 tagOf_PrimOp SameMutableArrayOp = ILIT(131)
410 tagOf_PrimOp SameMutableByteArrayOp = ILIT(132)
411 tagOf_PrimOp ReadArrayOp = ILIT(133)
412 tagOf_PrimOp WriteArrayOp = ILIT(134)
413 tagOf_PrimOp IndexArrayOp = ILIT(135)
414 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(136)
415 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(137)
416 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(138)
417 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(139)
418 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(140)
419 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(141)
420 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(142)
421 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(143)
422 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(144)
423 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(145)
424 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(146)
425 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147)
426 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148)
427 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(149)
428 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(150)
429 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(151)
430 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(152)
431 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(153)
432 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(154)
433 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(155)
434 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(156)
435 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(157)
436 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(158)
437 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(159)
438 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(160)
439 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(161)
440 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(162)
441 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(163)
442 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(164)
443 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(165)
444 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(166)
445 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(167)
446 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(168)
447 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(169)
448 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(170)
449 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(171)
450 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(172)
451 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(173)
452 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(174)
453 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(175)
454 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(176)
455 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(177)
456 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(178)
457 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(179)
458 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(180)
459 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(181)
460 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(182)
461 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(183)
462 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(184)
463 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(185)
464 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(186)
465 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(187)
466 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(188)
467 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(189)
468 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(190)
469 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(191)
470 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(192)
471 tagOf_PrimOp SizeofByteArrayOp = ILIT(193)
472 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(194)
473 tagOf_PrimOp NewSynchVarOp = ILIT(195)
474 tagOf_PrimOp TakeMVarOp = ILIT(196)
475 tagOf_PrimOp PutMVarOp = ILIT(197)
476 tagOf_PrimOp ReadIVarOp = ILIT(198)
477 tagOf_PrimOp WriteIVarOp = ILIT(199)
478 tagOf_PrimOp MakeForeignObjOp = ILIT(200)
479 tagOf_PrimOp WriteForeignObjOp = ILIT(201)
480 tagOf_PrimOp MakeStablePtrOp = ILIT(202)
481 tagOf_PrimOp DeRefStablePtrOp = ILIT(203)
482 tagOf_PrimOp (CCallOp _ _ _ _ _ _) = ILIT(204)
483 tagOf_PrimOp ErrorIOPrimOp = ILIT(205)
484 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(206)
485 tagOf_PrimOp SeqOp = ILIT(207)
486 tagOf_PrimOp ParOp = ILIT(208)
487 tagOf_PrimOp ForkOp = ILIT(209)
488 tagOf_PrimOp DelayOp = ILIT(210)
489 tagOf_PrimOp WaitReadOp = ILIT(211)
490 tagOf_PrimOp WaitWriteOp = ILIT(212)
491 tagOf_PrimOp ParGlobalOp = ILIT(213)
492 tagOf_PrimOp ParLocalOp = ILIT(214)
493 tagOf_PrimOp ParAtOp = ILIT(215)
494 tagOf_PrimOp ParAtAbsOp = ILIT(216)
495 tagOf_PrimOp ParAtRelOp = ILIT(217)
496 tagOf_PrimOp ParAtForNowOp = ILIT(218)
497 tagOf_PrimOp CopyableOp = ILIT(219)
498 tagOf_PrimOp NoFollowOp = ILIT(220)
499 tagOf_PrimOp SameMVarOp = ILIT(221)
501 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
503 instance Eq PrimOp where
504 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
507 An @Enum@-derived list would be better; meanwhile... (ToDo)
633 NewByteArrayOp CharRep,
634 NewByteArrayOp IntRep,
635 NewByteArrayOp WordRep,
636 NewByteArrayOp AddrRep,
637 NewByteArrayOp FloatRep,
638 NewByteArrayOp DoubleRep,
639 NewByteArrayOp StablePtrRep,
641 SameMutableByteArrayOp,
645 ReadByteArrayOp CharRep,
646 ReadByteArrayOp IntRep,
647 ReadByteArrayOp WordRep,
648 ReadByteArrayOp AddrRep,
649 ReadByteArrayOp FloatRep,
650 ReadByteArrayOp DoubleRep,
651 ReadByteArrayOp StablePtrRep,
652 ReadByteArrayOp Int64Rep,
653 ReadByteArrayOp Word64Rep,
654 WriteByteArrayOp CharRep,
655 WriteByteArrayOp IntRep,
656 WriteByteArrayOp WordRep,
657 WriteByteArrayOp AddrRep,
658 WriteByteArrayOp FloatRep,
659 WriteByteArrayOp DoubleRep,
660 WriteByteArrayOp StablePtrRep,
661 WriteByteArrayOp Int64Rep,
662 WriteByteArrayOp Word64Rep,
663 IndexByteArrayOp CharRep,
664 IndexByteArrayOp IntRep,
665 IndexByteArrayOp WordRep,
666 IndexByteArrayOp AddrRep,
667 IndexByteArrayOp FloatRep,
668 IndexByteArrayOp DoubleRep,
669 IndexByteArrayOp StablePtrRep,
670 IndexByteArrayOp Int64Rep,
671 IndexByteArrayOp Word64Rep,
672 IndexOffAddrOp CharRep,
673 IndexOffAddrOp IntRep,
674 IndexOffAddrOp WordRep,
675 IndexOffAddrOp AddrRep,
676 IndexOffAddrOp FloatRep,
677 IndexOffAddrOp DoubleRep,
678 IndexOffAddrOp StablePtrRep,
679 IndexOffAddrOp Int64Rep,
680 IndexOffAddrOp Word64Rep,
681 IndexOffForeignObjOp CharRep,
682 IndexOffForeignObjOp AddrRep,
683 IndexOffForeignObjOp IntRep,
684 IndexOffForeignObjOp WordRep,
685 IndexOffForeignObjOp FloatRep,
686 IndexOffForeignObjOp DoubleRep,
687 IndexOffForeignObjOp StablePtrRep,
688 IndexOffForeignObjOp Int64Rep,
689 IndexOffForeignObjOp Word64Rep,
690 WriteOffAddrOp CharRep,
691 WriteOffAddrOp IntRep,
692 WriteOffAddrOp WordRep,
693 WriteOffAddrOp AddrRep,
694 WriteOffAddrOp FloatRep,
695 WriteOffAddrOp DoubleRep,
696 WriteOffAddrOp StablePtrRep,
697 WriteOffAddrOp ForeignObjRep,
698 WriteOffAddrOp Int64Rep,
699 WriteOffAddrOp Word64Rep,
701 UnsafeFreezeByteArrayOp,
703 SizeofMutableByteArrayOp,
715 ReallyUnsafePtrEqualityOp,
734 %************************************************************************
736 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
738 %************************************************************************
740 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
741 refer to the primitive operation. The conventional \tr{#}-for-
742 unboxed ops is added on later.
744 The reason for the funny characters in the names is so we do not
745 interfere with the programmer's Haskell name spaces.
747 We use @PrimKinds@ for the ``type'' information, because they're
748 (slightly) more convenient to use than @TyCons@.
751 = Dyadic FAST_STRING -- string :: T -> T -> T
753 | Monadic FAST_STRING -- string :: T -> T
755 | Compare FAST_STRING -- string :: T -> T -> Bool
757 | Coercing FAST_STRING -- string :: T1 -> T2
761 | PrimResult FAST_STRING
762 [TyVar] [Type] TyCon PrimRep [Type]
763 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
764 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
765 -- D# is a primitive type constructor.
766 -- (the kind is the same info as D#, in another convenient form)
768 | AlgResult FAST_STRING
769 [TyVar] [Type] TyCon [Type]
770 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
771 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
773 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
778 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
780 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
781 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
782 an_Integer_and_Int_tys
783 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
786 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
788 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
790 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
792 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
795 @primOpInfo@ gives all essential information (from which everything
796 else, notably a type, can be constructed) for each @PrimOp@.
799 primOpInfo :: PrimOp -> PrimOpInfo
802 There's plenty of this stuff!
804 %************************************************************************
806 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
808 %************************************************************************
811 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
812 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
813 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
814 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
815 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
816 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
818 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
819 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
820 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
821 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
822 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
823 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
825 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
826 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
827 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
828 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
829 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
830 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
832 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
833 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
834 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
835 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
836 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
837 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
839 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
840 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
841 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
842 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
843 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
844 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
846 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
847 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
848 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
849 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
850 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
851 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
855 %************************************************************************
857 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
859 %************************************************************************
862 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
863 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
866 %************************************************************************
868 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
870 %************************************************************************
873 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
874 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
875 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
876 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
877 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
879 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
880 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
883 %************************************************************************
885 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
887 %************************************************************************
889 A @Word#@ is an unsigned @Int#@.
892 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
893 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
895 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
896 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
897 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
898 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
901 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
903 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
906 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
908 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
910 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
912 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
913 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
916 %************************************************************************
918 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
920 %************************************************************************
923 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
924 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
928 %************************************************************************
930 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
932 %************************************************************************
934 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
938 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
939 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
940 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
941 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
942 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
944 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
945 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
947 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
948 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
949 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
950 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
951 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
952 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
953 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
954 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
955 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
956 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
957 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
958 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
959 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
962 %************************************************************************
964 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
966 %************************************************************************
968 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
972 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
973 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
974 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
975 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
976 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
978 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
979 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
981 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
982 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
984 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
985 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
986 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
987 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
988 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
989 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
990 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
991 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
992 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
993 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
994 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
995 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
996 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
999 %************************************************************************
1001 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
1003 %************************************************************************
1006 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
1008 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
1009 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
1010 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
1012 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
1014 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
1015 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
1017 primOpInfo Integer2IntOp
1018 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
1020 primOpInfo Integer2WordOp
1021 = PrimResult SLIT("integer2Word#") [] one_Integer_ty wordPrimTyCon IntRep []
1023 primOpInfo Int2IntegerOp
1024 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
1026 primOpInfo Word2IntegerOp
1027 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
1029 primOpInfo Addr2IntegerOp
1030 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
1032 primOpInfo IntegerToInt64Op
1033 = PrimResult SLIT("integerToInt64#") [] one_Integer_ty int64PrimTyCon Int64Rep []
1035 primOpInfo Int64ToIntegerOp
1036 = AlgResult SLIT("int64ToInteger#") [] [int64PrimTy] integerTyCon []
1038 primOpInfo Word64ToIntegerOp
1039 = AlgResult SLIT("word64ToInteger#") [] [word64PrimTy] integerTyCon []
1041 primOpInfo IntegerToWord64Op
1042 = PrimResult SLIT("integerToWord64#") [] one_Integer_ty word64PrimTyCon Word64Rep []
1045 Encoding and decoding of floating-point numbers is sorta
1049 primOpInfo FloatEncodeOp
1050 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
1051 floatPrimTyCon FloatRep []
1053 primOpInfo DoubleEncodeOp
1054 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
1055 doublePrimTyCon DoubleRep []
1057 primOpInfo FloatDecodeOp
1058 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
1060 primOpInfo DoubleDecodeOp
1061 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
1064 %************************************************************************
1066 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
1068 %************************************************************************
1071 primOpInfo NewArrayOp
1073 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1075 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
1076 stateAndMutableArrayPrimTyCon [s, elt]
1078 primOpInfo (NewByteArrayOp kind)
1080 s = alphaTy; s_tv = alphaTyVar
1082 (str, _, prim_tycon) = getPrimRepInfo kind
1084 op_str = _PK_ ("new" ++ str ++ "Array#")
1086 AlgResult op_str [s_tv]
1087 [intPrimTy, mkStatePrimTy s]
1088 stateAndMutableByteArrayPrimTyCon [s]
1090 ---------------------------------------------------------------------------
1092 primOpInfo SameMutableArrayOp
1094 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1095 mut_arr_ty = mkMutableArrayPrimTy s elt
1097 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
1100 primOpInfo SameMutableByteArrayOp
1102 s = alphaTy; s_tv = alphaTyVar;
1103 mut_arr_ty = mkMutableByteArrayPrimTy s
1105 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1108 ---------------------------------------------------------------------------
1109 -- Primitive arrays of Haskell pointers:
1111 primOpInfo ReadArrayOp
1113 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1115 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1116 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1117 stateAndPtrPrimTyCon [s, elt]
1120 primOpInfo WriteArrayOp
1122 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1124 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1125 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1126 statePrimTyCon VoidRep [s]
1128 primOpInfo IndexArrayOp
1129 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1130 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1133 ---------------------------------------------------------------------------
1134 -- Primitive arrays full of unboxed bytes:
1136 primOpInfo (ReadByteArrayOp kind)
1138 s = alphaTy; s_tv = alphaTyVar
1140 (str, _, prim_tycon) = getPrimRepInfo kind
1142 op_str = _PK_ ("read" ++ str ++ "Array#")
1143 relevant_tycon = (assoc "primOpInfo{ReadByteArrayOp}" tbl kind)
1146 | kind == StablePtrRep = ([s, betaTy], [s_tv, betaTyVar])
1147 | otherwise = ([s], [s_tv])
1149 AlgResult op_str tvs
1150 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1151 relevant_tycon tycon_args
1153 tbl = [ (CharRep, stateAndCharPrimTyCon),
1154 (IntRep, stateAndIntPrimTyCon),
1155 (WordRep, stateAndWordPrimTyCon),
1156 (AddrRep, stateAndAddrPrimTyCon),
1157 (FloatRep, stateAndFloatPrimTyCon),
1158 (StablePtrRep, stateAndStablePtrPrimTyCon),
1159 (DoubleRep, stateAndDoublePrimTyCon) ]
1161 -- How come there's no Word byte arrays? ADR
1163 primOpInfo (WriteByteArrayOp kind)
1165 s = alphaTy; s_tv = alphaTyVar
1167 (str, prim_ty, _) = getPrimRepInfo kind
1168 op_str = _PK_ ("write" ++ str ++ "Array#")
1171 | kind == StablePtrRep = (mkStablePtrPrimTy betaTy, [s_tv, betaTyVar])
1172 | otherwise = (prim_ty, [s_tv])
1175 -- NB: *Prim*Result --
1176 PrimResult op_str tvs
1177 [mkMutableByteArrayPrimTy s, intPrimTy, the_prim_ty, mkStatePrimTy s]
1178 statePrimTyCon VoidRep [s]
1180 primOpInfo (IndexByteArrayOp kind)
1182 (str, _, prim_tycon) = getPrimRepInfo kind
1183 op_str = _PK_ ("index" ++ str ++ "Array#")
1185 (prim_tycon_args, tvs)
1186 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1187 | otherwise = ([],[])
1189 -- NB: *Prim*Result --
1190 PrimResult op_str tvs [byteArrayPrimTy, intPrimTy] prim_tycon kind prim_tycon_args
1192 primOpInfo (IndexOffAddrOp kind)
1194 (str, _, prim_tycon) = getPrimRepInfo kind
1195 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1197 (prim_tycon_args, tvs)
1198 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1199 | otherwise = ([], [])
1201 PrimResult op_str tvs [addrPrimTy, intPrimTy] prim_tycon kind prim_tycon_args
1203 primOpInfo (IndexOffForeignObjOp kind)
1205 (str, _, prim_tycon) = getPrimRepInfo kind
1206 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1208 (prim_tycon_args, tvs)
1209 | kind == StablePtrRep = ([alphaTy], [alphaTyVar])
1210 | otherwise = ([], [])
1212 PrimResult op_str tvs [foreignObjPrimTy, intPrimTy] prim_tycon kind prim_tycon_args
1214 primOpInfo (WriteOffAddrOp kind)
1216 s = alphaTy; s_tv = alphaTyVar
1218 (str, prim_ty, _) = getPrimRepInfo kind
1219 op_str = _PK_ ("write" ++ str ++ "OffAddr#")
1221 -- NB: *Prim*Result --
1222 PrimResult op_str [s_tv]
1223 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
1224 statePrimTyCon VoidRep [s]
1226 ---------------------------------------------------------------------------
1227 primOpInfo UnsafeFreezeArrayOp
1229 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1231 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1232 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1233 stateAndArrayPrimTyCon [s, elt]
1235 primOpInfo UnsafeFreezeByteArrayOp
1236 = let { s = alphaTy; s_tv = alphaTyVar } in
1237 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1238 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1239 stateAndByteArrayPrimTyCon [s]
1240 ---------------------------------------------------------------------------
1241 primOpInfo SizeofByteArrayOp
1243 SLIT("sizeofByteArray#") []
1245 intPrimTyCon IntRep []
1247 primOpInfo SizeofMutableByteArrayOp
1248 = let { s = alphaTy; s_tv = alphaTyVar } in
1250 SLIT("sizeofMutableByteArray#") [s_tv]
1251 [mkMutableByteArrayPrimTy s]
1252 intPrimTyCon IntRep []
1256 %************************************************************************
1258 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1260 %************************************************************************
1263 primOpInfo NewSynchVarOp
1265 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1267 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1268 stateAndSynchVarPrimTyCon [s, elt]
1270 primOpInfo SameMVarOp
1272 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
1273 mvar_ty = mkSynchVarPrimTy s elt
1275 AlgResult SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty]
1278 primOpInfo TakeMVarOp
1280 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1282 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1283 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1284 stateAndPtrPrimTyCon [s, elt]
1286 primOpInfo PutMVarOp
1288 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1290 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1291 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1294 primOpInfo ReadIVarOp
1296 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1298 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1299 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1300 stateAndPtrPrimTyCon [s, elt]
1302 primOpInfo WriteIVarOp
1304 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1306 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1307 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1312 %************************************************************************
1314 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1316 %************************************************************************
1322 s = alphaTy; s_tv = alphaTyVar
1324 PrimResult SLIT("delay#") [s_tv]
1325 [intPrimTy, mkStatePrimTy s]
1326 statePrimTyCon VoidRep [s]
1328 primOpInfo WaitReadOp
1330 s = alphaTy; s_tv = alphaTyVar
1332 PrimResult SLIT("waitRead#") [s_tv]
1333 [intPrimTy, mkStatePrimTy s]
1334 statePrimTyCon VoidRep [s]
1336 primOpInfo WaitWriteOp
1338 s = alphaTy; s_tv = alphaTyVar
1340 PrimResult SLIT("waitWrite#") [s_tv]
1341 [intPrimTy, mkStatePrimTy s]
1342 statePrimTyCon VoidRep [s]
1345 %************************************************************************
1347 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1349 %************************************************************************
1351 Not everything should/can be in the Haskell heap. As an example, in an
1352 image processing application written in Haskell, you really would like
1353 to avoid heaving huge images between different space or generations of
1354 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1355 which refer to some externally allocated structure/value. Using @ForeignObj@,
1356 just a reference to an image is present in the heap, the image could then
1357 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1358 a completely separate address space alltogether.
1360 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1361 associated with the object is invoked (currently, each ForeignObj has a
1362 direct reference to its finaliser). -- SOF
1364 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1367 makeForeignObj# :: Addr# -- foreign object
1368 -> Addr# -- ptr to its finaliser routine
1369 -> StateAndForeignObj# _RealWorld# ForeignObj#
1374 primOpInfo MakeForeignObjOp
1375 = AlgResult SLIT("makeForeignObj#") []
1376 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1377 stateAndForeignObjPrimTyCon [realWorldTy]
1381 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1382 the external object wrapped up inside a @ForeignObj@. This primitive is used
1383 when a mixed programming interface of implicit and explicit de-allocation is used,
1384 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1385 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1386 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1387 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1388 We deal with this situation, by allowing the programmer to destructively modify
1389 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1390 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1393 writeForeignObj# :: ForeignObj# -- foreign object
1394 -> Addr# -- new data value
1395 -> StateAndForeignObj# _RealWorld# ForeignObj#
1399 primOpInfo WriteForeignObjOp
1401 s = alphaTy; s_tv = alphaTyVar
1403 PrimResult SLIT("writeForeignObj#") [s_tv]
1404 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1405 statePrimTyCon VoidRep [s]
1408 %************************************************************************
1410 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1412 %************************************************************************
1414 A {\em stable pointer} is an index into a table of pointers into the
1415 heap. Since the garbage collector is told about stable pointers, it
1416 is safe to pass a stable pointer to external systems such as C
1419 Here's what the operations and types are supposed to be (from
1420 state-interface document).
1423 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1424 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1425 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1428 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1429 operation since it doesn't (directly) involve IO operations. The
1430 reason is that if some optimisation pass decided to duplicate calls to
1431 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1432 massive space leak can result. Putting it into the PrimIO monad
1433 prevents this. (Another reason for putting them in a monad is to
1434 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1437 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1438 besides, it's not likely to be used from Haskell) so it's not a
1441 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1444 primOpInfo MakeStablePtrOp
1445 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1446 [alphaTy, realWorldStatePrimTy]
1447 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1449 primOpInfo DeRefStablePtrOp
1450 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1451 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1452 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1455 %************************************************************************
1457 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1459 %************************************************************************
1461 [Alastair Reid is to blame for this!]
1463 These days, (Glasgow) Haskell seems to have a bit of everything from
1464 other languages: strict operations, mutable variables, sequencing,
1465 pointers, etc. About the only thing left is LISP's ability to test
1466 for pointer equality. So, let's add it in!
1469 reallyUnsafePtrEquality :: a -> a -> Int#
1472 which tests any two closures (of the same type) to see if they're the
1473 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1474 difficulties of trying to box up the result.)
1476 NB This is {\em really unsafe\/} because even something as trivial as
1477 a garbage collection might change the answer by removing indirections.
1478 Still, no-one's forcing you to use it. If you're worried about little
1479 things like loss of referential transparency, you might like to wrap
1480 it all up in a monad-like thing as John O'Donnell and John Hughes did
1481 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1484 I'm thinking of using it to speed up a critical equality test in some
1485 graphics stuff in a context where the possibility of saying that
1486 denotationally equal things aren't isn't a problem (as long as it
1487 doesn't happen too often.) ADR
1489 To Will: Jim said this was already in, but I can't see it so I'm
1490 adding it. Up to you whether you add it. (Note that this could have
1491 been readily implemented using a @veryDangerousCCall@ before they were
1495 primOpInfo ReallyUnsafePtrEqualityOp
1496 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1497 [alphaTy, alphaTy] intPrimTyCon IntRep []
1500 %************************************************************************
1502 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1504 %************************************************************************
1507 primOpInfo SeqOp -- seq# :: a -> Int#
1508 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1510 primOpInfo ParOp -- par# :: a -> Int#
1511 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1513 primOpInfo ForkOp -- fork# :: a -> Int#
1514 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1519 -- HWL: The first 4 Int# in all par... annotations denote:
1520 -- name, granularity info, size of result, degree of parallelism
1521 -- Same structure as _seq_ i.e. returns Int#
1523 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1524 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1526 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1527 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1529 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1530 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1532 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1533 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1535 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1536 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1538 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1539 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1541 primOpInfo CopyableOp -- copyable# :: a -> a
1542 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1544 primOpInfo NoFollowOp -- noFollow# :: a -> a
1545 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1548 %************************************************************************
1550 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1552 %************************************************************************
1555 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1556 primOpInfo ErrorIOPrimOp
1557 = PrimResult SLIT("errorIO#") [alphaTyVar]
1558 [mkFunTy realWorldStatePrimTy alphaTy]
1559 statePrimTyCon VoidRep [realWorldTy]
1562 %************************************************************************
1564 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1566 %************************************************************************
1569 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
1570 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1572 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
1575 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1579 %************************************************************************
1581 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1583 %************************************************************************
1585 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1586 with @Integers@ can trigger GC. Here we describe the heap requirements
1587 of the various @PrimOps@. For most, no heap is required. For a few,
1588 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1589 be combined with the rest of the heap usage in the basic block. For an
1590 unfortunate few, some unknown amount of heap is required (these are the
1591 ops which can trigger GC).
1594 data HeapRequirement
1596 | FixedHeapRequired HeapOffset
1597 | VariableHeapRequired
1599 primOpHeapReq :: PrimOp -> HeapRequirement
1601 primOpHeapReq NewArrayOp = VariableHeapRequired
1602 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1604 primOpHeapReq IntegerAddOp = VariableHeapRequired
1605 primOpHeapReq IntegerSubOp = VariableHeapRequired
1606 primOpHeapReq IntegerMulOp = VariableHeapRequired
1607 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1608 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1609 primOpHeapReq IntegerNegOp = VariableHeapRequired
1610 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1611 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1612 (intOff mIN_MP_INT_SIZE))
1613 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1614 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1615 (intOff mIN_MP_INT_SIZE))
1616 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1617 primOpHeapReq IntegerToInt64Op = FixedHeapRequired
1618 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1619 (intOff mIN_MP_INT_SIZE))
1620 primOpHeapReq Word64ToIntegerOp = FixedHeapRequired
1621 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1622 (intOff mIN_MP_INT_SIZE))
1623 primOpHeapReq Int64ToIntegerOp = FixedHeapRequired
1624 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1625 (intOff mIN_MP_INT_SIZE))
1626 primOpHeapReq IntegerToWord64Op = FixedHeapRequired
1627 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1628 (intOff mIN_MP_INT_SIZE))
1629 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1630 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1631 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1632 (intOff mIN_MP_INT_SIZE)))
1633 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1634 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1635 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1636 (intOff mIN_MP_INT_SIZE)))
1639 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1640 or if it returns a ForeignObj.
1642 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1643 why do we need to be so indeterminate about it? --SOF
1645 primOpHeapReq (CCallOp _ _ mayGC@True _ _ _) = VariableHeapRequired
1646 primOpHeapReq (CCallOp _ _ mayGC@False _ _ _) = NoHeapRequired
1648 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1649 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1651 -- this occasionally has to expand the Stable Pointer table
1652 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1654 -- These four only need heap space with the native code generator
1655 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1657 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1658 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1659 primOpHeapReq Integer2WordOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1660 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1661 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1663 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1664 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1665 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1667 -- Sparking ops no longer allocate any heap; however, _fork_ may
1668 -- require a context switch to clear space in the required thread
1669 -- pool, and that requires liveness information.
1671 primOpHeapReq ParOp = NoHeapRequired
1672 primOpHeapReq ForkOp = VariableHeapRequired
1674 -- A SeqOp requires unknown space to evaluate its argument
1675 primOpHeapReq SeqOp = VariableHeapRequired
1677 -- GranSim sparks are stgMalloced i.e. no heap required
1678 primOpHeapReq ParGlobalOp = NoHeapRequired
1679 primOpHeapReq ParLocalOp = NoHeapRequired
1680 primOpHeapReq ParAtOp = NoHeapRequired
1681 primOpHeapReq ParAtAbsOp = NoHeapRequired
1682 primOpHeapReq ParAtRelOp = NoHeapRequired
1683 primOpHeapReq ParAtForNowOp = NoHeapRequired
1684 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1685 primOpHeapReq CopyableOp = NoHeapRequired
1686 primOpHeapReq NoFollowOp = NoHeapRequired
1688 primOpHeapReq other_op = NoHeapRequired
1691 The amount of stack required by primops.
1694 data StackRequirement
1696 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1697 | VariableStackRequired
1699 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1700 primOpStackRequired _ = VariableStackRequired
1701 -- ToDo: be more specific for certain primops (currently only used for seq)
1704 Primops which can trigger GC have to be called carefully.
1705 In particular, their arguments are guaranteed to be in registers,
1706 and a liveness mask tells which regs are live.
1709 primOpCanTriggerGC op
1717 case primOpHeapReq op of
1718 VariableHeapRequired -> True
1722 Sometimes we may choose to execute a PrimOp even though it isn't
1723 certain that its result will be required; ie execute them
1724 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1725 this is OK, because PrimOps are usually cheap, but it isn't OK for
1726 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1728 See also @primOpIsCheap@ (below).
1730 There should be no worries about side effects; that's all taken care
1731 of by data dependencies.
1734 primOpOkForSpeculation :: PrimOp -> Bool
1737 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1738 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1741 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1742 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1744 -- Float. ToDo: tan? tanh?
1745 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1746 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1747 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1748 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1750 -- Double. ToDo: tan? tanh?
1751 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1752 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1753 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1754 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1757 primOpOkForSpeculation (CCallOp _ _ _ _ _ _) = False -- Could be expensive!
1760 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1763 primOpOkForSpeculation ParOp = False -- Could be expensive!
1764 primOpOkForSpeculation ForkOp = False -- Likewise
1765 primOpOkForSpeculation SeqOp = False -- Likewise
1767 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1768 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1769 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1770 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1771 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1772 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1773 primOpOkForSpeculation CopyableOp = False -- only tags closure
1774 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1776 -- The default is "yes it's ok for speculation"
1777 primOpOkForSpeculation other_op = True
1780 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1781 WARNING), we just borrow some other predicates for a
1782 what-should-be-good-enough test.
1785 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1788 And some primops have side-effects and so, for example, must not be
1792 fragilePrimOp :: PrimOp -> Bool
1794 fragilePrimOp ParOp = True
1795 fragilePrimOp ForkOp = True
1796 fragilePrimOp SeqOp = True
1797 fragilePrimOp MakeForeignObjOp = True -- SOF
1798 fragilePrimOp WriteForeignObjOp = True -- SOF
1799 fragilePrimOp MakeStablePtrOp = True
1800 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1802 fragilePrimOp ParGlobalOp = True
1803 fragilePrimOp ParLocalOp = True
1804 fragilePrimOp ParAtOp = True
1805 fragilePrimOp ParAtAbsOp = True
1806 fragilePrimOp ParAtRelOp = True
1807 fragilePrimOp ParAtForNowOp = True
1808 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1809 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1811 fragilePrimOp other = False
1814 Primitive operations that perform calls need wrappers to save any live variables
1815 that are stored in caller-saves registers
1818 primOpNeedsWrapper :: PrimOp -> Bool
1820 primOpNeedsWrapper (CCallOp _ _ _ _ _ _) = True
1822 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1823 primOpNeedsWrapper (NewByteArrayOp _) = True
1825 primOpNeedsWrapper IntegerAddOp = True
1826 primOpNeedsWrapper IntegerSubOp = True
1827 primOpNeedsWrapper IntegerMulOp = True
1828 primOpNeedsWrapper IntegerQuotRemOp = True
1829 primOpNeedsWrapper IntegerDivModOp = True
1830 primOpNeedsWrapper IntegerNegOp = True
1831 primOpNeedsWrapper IntegerCmpOp = True
1832 primOpNeedsWrapper Integer2IntOp = True
1833 primOpNeedsWrapper Integer2WordOp = True
1834 primOpNeedsWrapper Int2IntegerOp = True
1835 primOpNeedsWrapper Word2IntegerOp = True
1836 primOpNeedsWrapper Addr2IntegerOp = True
1837 primOpNeedsWrapper IntegerToInt64Op = True
1838 primOpNeedsWrapper IntegerToWord64Op = True
1839 primOpNeedsWrapper Word64ToIntegerOp = True
1840 primOpNeedsWrapper Int64ToIntegerOp = True
1842 primOpNeedsWrapper FloatExpOp = True
1843 primOpNeedsWrapper FloatLogOp = True
1844 primOpNeedsWrapper FloatSqrtOp = True
1845 primOpNeedsWrapper FloatSinOp = True
1846 primOpNeedsWrapper FloatCosOp = True
1847 primOpNeedsWrapper FloatTanOp = True
1848 primOpNeedsWrapper FloatAsinOp = True
1849 primOpNeedsWrapper FloatAcosOp = True
1850 primOpNeedsWrapper FloatAtanOp = True
1851 primOpNeedsWrapper FloatSinhOp = True
1852 primOpNeedsWrapper FloatCoshOp = True
1853 primOpNeedsWrapper FloatTanhOp = True
1854 primOpNeedsWrapper FloatPowerOp = True
1855 primOpNeedsWrapper FloatEncodeOp = True
1856 primOpNeedsWrapper FloatDecodeOp = True
1858 primOpNeedsWrapper DoubleExpOp = True
1859 primOpNeedsWrapper DoubleLogOp = True
1860 primOpNeedsWrapper DoubleSqrtOp = True
1861 primOpNeedsWrapper DoubleSinOp = True
1862 primOpNeedsWrapper DoubleCosOp = True
1863 primOpNeedsWrapper DoubleTanOp = True
1864 primOpNeedsWrapper DoubleAsinOp = True
1865 primOpNeedsWrapper DoubleAcosOp = True
1866 primOpNeedsWrapper DoubleAtanOp = True
1867 primOpNeedsWrapper DoubleSinhOp = True
1868 primOpNeedsWrapper DoubleCoshOp = True
1869 primOpNeedsWrapper DoubleTanhOp = True
1870 primOpNeedsWrapper DoublePowerOp = True
1871 primOpNeedsWrapper DoubleEncodeOp = True
1872 primOpNeedsWrapper DoubleDecodeOp = True
1874 primOpNeedsWrapper MakeForeignObjOp = True
1875 primOpNeedsWrapper WriteForeignObjOp = True
1876 primOpNeedsWrapper MakeStablePtrOp = True
1877 primOpNeedsWrapper DeRefStablePtrOp = True
1879 primOpNeedsWrapper TakeMVarOp = True
1880 primOpNeedsWrapper PutMVarOp = True
1881 primOpNeedsWrapper ReadIVarOp = True
1883 primOpNeedsWrapper DelayOp = True
1884 primOpNeedsWrapper WaitReadOp = True
1885 primOpNeedsWrapper WaitWriteOp = True
1887 primOpNeedsWrapper other_op = False
1892 = case (primOpInfo op) of
1894 Monadic str _ -> str
1895 Compare str _ -> str
1896 Coercing str _ _ -> str
1897 PrimResult str _ _ _ _ _ -> str
1898 AlgResult str _ _ _ _ -> str
1901 @primOpType@ duplicates some work of @primOpId@, but since we
1902 grab types pretty often...
1904 primOpType :: PrimOp -> Type
1907 = case (primOpInfo op) of
1908 Dyadic str ty -> dyadic_fun_ty ty
1909 Monadic str ty -> monadic_fun_ty ty
1910 Compare str ty -> compare_fun_ty ty
1911 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1913 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1914 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
1916 AlgResult str tyvars arg_tys tycon res_tys ->
1917 mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
1921 data PrimOpResultInfo
1922 = ReturnsPrim PrimRep
1925 -- ToDo: Deal with specialised PrimOps
1926 -- Will need to return specialised tycon and data constructors
1928 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1930 getPrimOpResultInfo op
1931 = case (primOpInfo op) of
1932 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1933 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1934 Compare _ ty -> ReturnsAlg boolTyCon
1935 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1936 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1937 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1939 isCompareOp :: PrimOp -> Bool
1942 = case primOpInfo op of
1947 The commutable ops are those for which we will try to move constants
1948 to the right hand side for strength reduction.
1951 commutableOp :: PrimOp -> Bool
1953 commutableOp CharEqOp = True
1954 commutableOp CharNeOp = True
1955 commutableOp IntAddOp = True
1956 commutableOp IntMulOp = True
1957 commutableOp AndOp = True
1958 commutableOp OrOp = True
1959 commutableOp XorOp = True
1960 commutableOp IntEqOp = True
1961 commutableOp IntNeOp = True
1962 commutableOp IntegerAddOp = True
1963 commutableOp IntegerMulOp = True
1964 commutableOp FloatAddOp = True
1965 commutableOp FloatMulOp = True
1966 commutableOp FloatEqOp = True
1967 commutableOp FloatNeOp = True
1968 commutableOp DoubleAddOp = True
1969 commutableOp DoubleMulOp = True
1970 commutableOp DoubleEqOp = True
1971 commutableOp DoubleNeOp = True
1972 commutableOp _ = False
1977 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1978 monadic_fun_ty ty = mkFunTy ty ty
1979 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1984 pprPrimOp :: PrimOp -> SDoc
1985 showPrimOp :: PrimOp -> String
1987 showPrimOp op = showSDoc (pprPrimOp op)
1989 pprPrimOp (CCallOp fun is_casm may_gc cconv arg_tys res_ty)
1991 callconv = text "{-" <> pprCallConv cconv <> text "-}"
1994 | is_casm && may_gc = "_casm_GC_ ``"
1995 | is_casm = "casm_ ``"
1996 | may_gc = "_ccall_GC_ "
1997 | otherwise = "_ccall_ "
2000 | is_casm = text "''"
2004 = hsep (map pprParendType (res_ty:arg_tys))
2008 Right _ -> ptext SLIT("<dynamic>")
2012 hcat [ ifPprDebug callconv
2013 , text before , ppr_fun , after, space, brackets pp_tys]
2016 = getPprStyle $ \ sty ->
2017 if codeStyle sty then -- For C just print the primop itself
2019 else if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
2020 ptext SLIT("PrelGHC.") <> ptext str
2021 else -- Unqualified is good enough
2024 str = primOp_str other_op
2027 instance Outputable PrimOp where
2028 ppr op = pprPrimOp op