2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\r
4 \section[PrimOp]{Primitive operations (machine-level)}
\r
8 PrimOp(..), allThePrimOps,
\r
9 primOpType, primOpSig, primOpUsg,
\r
10 mkPrimOpIdName, primOpRdrName,
\r
14 primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
\r
15 primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
\r
16 primOpHasSideEffects,
\r
18 getPrimOpResultInfo, PrimOpResultInfo(..),
\r
23 #include "HsVersions.h"
\r
25 import PrimRep -- most of it
\r
29 import Demand ( Demand, wwLazy, wwPrim, wwStrict )
\r
30 import Var ( TyVar, Id )
\r
31 import CallConv ( CallConv, pprCallConv )
\r
32 import PprType ( pprParendType )
\r
33 import Name ( Name, mkWiredInIdName )
\r
34 import RdrName ( RdrName, mkRdrQual )
\r
35 import OccName ( OccName, pprOccName, mkSrcVarOcc )
\r
36 import TyCon ( TyCon, tyConArity )
\r
37 import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
\r
38 mkTyConTy, mkTyConApp, typePrimRep,
\r
39 splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
\r
40 UsageAnn(..), mkUsgTy
\r
42 import Unique ( Unique, mkPrimOpIdUnique )
\r
43 import PrelMods ( pREL_GHC, pREL_GHC_Name )
\r
45 import Util ( assoc, zipWithEqual )
\r
46 import GlaExts ( Int(..), Int#, (==#) )
\r
49 %************************************************************************
\r
51 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
\r
53 %************************************************************************
\r
55 These are in \tr{state-interface.verb} order.
\r
59 -- dig the FORTRAN/C influence on the names...
\r
63 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
\r
64 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
\r
65 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
\r
66 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
\r
67 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
\r
68 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
\r
70 -- Char#-related ops:
\r
73 -- Int#-related ops:
\r
74 -- IntAbsOp unused?? ADR
\r
75 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
\r
76 | IntRemOp | IntNegOp | IntAbsOp
\r
77 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
\r
82 -- Word#-related ops:
\r
83 | WordQuotOp | WordRemOp
\r
84 | AndOp | OrOp | NotOp | XorOp
\r
85 | SllOp | SrlOp -- shift {left,right} {logical}
\r
86 | Int2WordOp | Word2IntOp -- casts
\r
88 -- Addr#-related ops:
\r
89 | Int2AddrOp | Addr2IntOp -- casts
\r
91 -- Float#-related ops:
\r
92 | FloatAddOp | FloatSubOp | FloatMulOp | FloatDivOp | FloatNegOp
\r
93 | Float2IntOp | Int2FloatOp
\r
95 | FloatExpOp | FloatLogOp | FloatSqrtOp
\r
96 | FloatSinOp | FloatCosOp | FloatTanOp
\r
97 | FloatAsinOp | FloatAcosOp | FloatAtanOp
\r
98 | FloatSinhOp | FloatCoshOp | FloatTanhOp
\r
99 -- not all machines have these available conveniently:
\r
100 -- | FloatAsinhOp | FloatAcoshOp | FloatAtanhOp
\r
101 | FloatPowerOp -- ** op
\r
103 -- Double#-related ops:
\r
104 | DoubleAddOp | DoubleSubOp | DoubleMulOp | DoubleDivOp | DoubleNegOp
\r
105 | Double2IntOp | Int2DoubleOp
\r
106 | Double2FloatOp | Float2DoubleOp
\r
108 | DoubleExpOp | DoubleLogOp | DoubleSqrtOp
\r
109 | DoubleSinOp | DoubleCosOp | DoubleTanOp
\r
110 | DoubleAsinOp | DoubleAcosOp | DoubleAtanOp
\r
111 | DoubleSinhOp | DoubleCoshOp | DoubleTanhOp
\r
112 -- not all machines have these available conveniently:
\r
113 -- | DoubleAsinhOp | DoubleAcoshOp | DoubleAtanhOp
\r
114 | DoublePowerOp -- ** op
\r
116 -- Integer (and related...) ops:
\r
117 -- slightly weird -- to match GMP package.
\r
118 | IntegerAddOp | IntegerSubOp | IntegerMulOp | IntegerGcdOp
\r
119 | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp
\r
124 | Integer2IntOp | Integer2WordOp
\r
125 | Int2IntegerOp | Word2IntegerOp
\r
127 -- casting to/from Integer and 64-bit (un)signed quantities.
\r
128 | IntegerToInt64Op | Int64ToIntegerOp
\r
129 | IntegerToWord64Op | Word64ToIntegerOp
\r
135 -- primitive ops for primitive arrays
\r
138 | NewByteArrayOp PrimRep
\r
140 | SameMutableArrayOp
\r
141 | SameMutableByteArrayOp
\r
143 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
\r
145 | ReadByteArrayOp PrimRep
\r
146 | WriteByteArrayOp PrimRep
\r
147 | IndexByteArrayOp PrimRep
\r
148 | IndexOffAddrOp PrimRep
\r
149 | WriteOffAddrOp PrimRep
\r
150 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
\r
151 -- This is just a cheesy encoding of a bunch of ops.
\r
152 -- Note that ForeignObjRep is not included -- the only way of
\r
153 -- creating a ForeignObj is with a ccall or casm.
\r
154 | IndexOffForeignObjOp PrimRep
\r
156 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
\r
157 | UnsafeThawArrayOp | UnsafeThawByteArrayOp
\r
158 | SizeofByteArrayOp | SizeofMutableByteArrayOp
\r
160 -- Mutable variables
\r
179 | WriteForeignObjOp
\r
189 | StableNameToIntOp
\r
197 A special ``trap-door'' to use in making calls direct to C functions:
\r
200 FAST_STRING -- Left fn => An "unboxed" ccall# to `fn'.
\r
201 Unique) -- Right u => first argument (an Addr#) is the function pointer
\r
202 -- (unique is used to generate a 'typedef' to cast
\r
203 -- the function pointer if compiling the ccall# down to
\r
204 -- .hc code - can't do this inline for tedious reasons.)
\r
206 Bool -- True <=> really a "casm"
\r
207 Bool -- True <=> might invoke Haskell GC
\r
208 CallConv -- calling convention to use.
\r
210 -- (... to be continued ... )
\r
213 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
\r
214 (See @primOpInfo@ for details.)
\r
216 Note: that first arg and part of the result should be the system state
\r
217 token (which we carry around to fool over-zealous optimisers) but
\r
218 which isn't actually passed.
\r
220 For example, we represent
\r
222 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
\r
228 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
\r
229 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
\r
233 (AlgAlts [ ( FloatPrimAndIoWorld,
\r
235 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
\r
241 Nota Bene: there are some people who find the empty list of types in
\r
242 the @Prim@ somewhat puzzling and would represent the above by
\r
246 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
\r
247 -- :: /\ alpha1, alpha2 alpha3, alpha4.
\r
248 -- alpha1 -> alpha2 -> alpha3 -> alpha4
\r
249 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
\r
252 (AlgAlts [ ( FloatPrimAndIoWorld,
\r
254 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
\r
260 But, this is a completely different way of using @CCallOp@. The most
\r
261 major changes required if we switch to this are in @primOpInfo@, and
\r
262 the desugarer. The major difficulty is in moving the HeapRequirement
\r
263 stuff somewhere appropriate. (The advantage is that we could simplify
\r
264 @CCallOp@ and record just the number of arguments with corresponding
\r
265 simplifications in reading pragma unfoldings, the simplifier,
\r
266 instantiation (etc) of core expressions, ... . Maybe we should think
\r
267 about using it this way?? ADR)
\r
270 -- (... continued from above ... )
\r
272 -- Operation to test two closure addresses for equality (yes really!)
\r
273 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
\r
274 | ReallyUnsafePtrEqualityOp
\r
289 -- more parallel stuff
\r
290 | ParGlobalOp -- named global par
\r
291 | ParLocalOp -- named local par
\r
292 | ParAtOp -- specifies destination of local par
\r
293 | ParAtAbsOp -- specifies destination of local par (abs processor)
\r
294 | ParAtRelOp -- specifies destination of local par (rel processor)
\r
295 | ParAtForNowOp -- specifies initial destination of global par
\r
296 | CopyableOp -- marks copyable code
\r
297 | NoFollowOp -- marks non-followup expression
\r
304 Used for the Ord instance
\r
307 tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
\r
308 tagOf_PrimOp CharGeOp = ILIT( 2)
\r
309 tagOf_PrimOp CharEqOp = ILIT( 3)
\r
310 tagOf_PrimOp CharNeOp = ILIT( 4)
\r
311 tagOf_PrimOp CharLtOp = ILIT( 5)
\r
312 tagOf_PrimOp CharLeOp = ILIT( 6)
\r
313 tagOf_PrimOp IntGtOp = ILIT( 7)
\r
314 tagOf_PrimOp IntGeOp = ILIT( 8)
\r
315 tagOf_PrimOp IntEqOp = ILIT( 9)
\r
316 tagOf_PrimOp IntNeOp = ILIT( 10)
\r
317 tagOf_PrimOp IntLtOp = ILIT( 11)
\r
318 tagOf_PrimOp IntLeOp = ILIT( 12)
\r
319 tagOf_PrimOp WordGtOp = ILIT( 13)
\r
320 tagOf_PrimOp WordGeOp = ILIT( 14)
\r
321 tagOf_PrimOp WordEqOp = ILIT( 15)
\r
322 tagOf_PrimOp WordNeOp = ILIT( 16)
\r
323 tagOf_PrimOp WordLtOp = ILIT( 17)
\r
324 tagOf_PrimOp WordLeOp = ILIT( 18)
\r
325 tagOf_PrimOp AddrGtOp = ILIT( 19)
\r
326 tagOf_PrimOp AddrGeOp = ILIT( 20)
\r
327 tagOf_PrimOp AddrEqOp = ILIT( 21)
\r
328 tagOf_PrimOp AddrNeOp = ILIT( 22)
\r
329 tagOf_PrimOp AddrLtOp = ILIT( 23)
\r
330 tagOf_PrimOp AddrLeOp = ILIT( 24)
\r
331 tagOf_PrimOp FloatGtOp = ILIT( 25)
\r
332 tagOf_PrimOp FloatGeOp = ILIT( 26)
\r
333 tagOf_PrimOp FloatEqOp = ILIT( 27)
\r
334 tagOf_PrimOp FloatNeOp = ILIT( 28)
\r
335 tagOf_PrimOp FloatLtOp = ILIT( 29)
\r
336 tagOf_PrimOp FloatLeOp = ILIT( 30)
\r
337 tagOf_PrimOp DoubleGtOp = ILIT( 31)
\r
338 tagOf_PrimOp DoubleGeOp = ILIT( 32)
\r
339 tagOf_PrimOp DoubleEqOp = ILIT( 33)
\r
340 tagOf_PrimOp DoubleNeOp = ILIT( 34)
\r
341 tagOf_PrimOp DoubleLtOp = ILIT( 35)
\r
342 tagOf_PrimOp DoubleLeOp = ILIT( 36)
\r
343 tagOf_PrimOp OrdOp = ILIT( 37)
\r
344 tagOf_PrimOp ChrOp = ILIT( 38)
\r
345 tagOf_PrimOp IntAddOp = ILIT( 39)
\r
346 tagOf_PrimOp IntSubOp = ILIT( 40)
\r
347 tagOf_PrimOp IntMulOp = ILIT( 41)
\r
348 tagOf_PrimOp IntQuotOp = ILIT( 42)
\r
349 tagOf_PrimOp IntRemOp = ILIT( 43)
\r
350 tagOf_PrimOp IntNegOp = ILIT( 44)
\r
351 tagOf_PrimOp IntAbsOp = ILIT( 45)
\r
352 tagOf_PrimOp WordQuotOp = ILIT( 46)
\r
353 tagOf_PrimOp WordRemOp = ILIT( 47)
\r
354 tagOf_PrimOp AndOp = ILIT( 48)
\r
355 tagOf_PrimOp OrOp = ILIT( 49)
\r
356 tagOf_PrimOp NotOp = ILIT( 50)
\r
357 tagOf_PrimOp XorOp = ILIT( 51)
\r
358 tagOf_PrimOp SllOp = ILIT( 52)
\r
359 tagOf_PrimOp SrlOp = ILIT( 53)
\r
360 tagOf_PrimOp ISllOp = ILIT( 54)
\r
361 tagOf_PrimOp ISraOp = ILIT( 55)
\r
362 tagOf_PrimOp ISrlOp = ILIT( 56)
\r
363 tagOf_PrimOp IntAddCOp = ILIT( 57)
\r
364 tagOf_PrimOp IntSubCOp = ILIT( 58)
\r
365 tagOf_PrimOp IntMulCOp = ILIT( 59)
\r
366 tagOf_PrimOp Int2WordOp = ILIT( 60)
\r
367 tagOf_PrimOp Word2IntOp = ILIT( 61)
\r
368 tagOf_PrimOp Int2AddrOp = ILIT( 62)
\r
369 tagOf_PrimOp Addr2IntOp = ILIT( 63)
\r
371 tagOf_PrimOp FloatAddOp = ILIT( 64)
\r
372 tagOf_PrimOp FloatSubOp = ILIT( 65)
\r
373 tagOf_PrimOp FloatMulOp = ILIT( 66)
\r
374 tagOf_PrimOp FloatDivOp = ILIT( 67)
\r
375 tagOf_PrimOp FloatNegOp = ILIT( 68)
\r
376 tagOf_PrimOp Float2IntOp = ILIT( 69)
\r
377 tagOf_PrimOp Int2FloatOp = ILIT( 70)
\r
378 tagOf_PrimOp FloatExpOp = ILIT( 71)
\r
379 tagOf_PrimOp FloatLogOp = ILIT( 72)
\r
380 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
\r
381 tagOf_PrimOp FloatSinOp = ILIT( 74)
\r
382 tagOf_PrimOp FloatCosOp = ILIT( 75)
\r
383 tagOf_PrimOp FloatTanOp = ILIT( 76)
\r
384 tagOf_PrimOp FloatAsinOp = ILIT( 77)
\r
385 tagOf_PrimOp FloatAcosOp = ILIT( 78)
\r
386 tagOf_PrimOp FloatAtanOp = ILIT( 79)
\r
387 tagOf_PrimOp FloatSinhOp = ILIT( 80)
\r
388 tagOf_PrimOp FloatCoshOp = ILIT( 81)
\r
389 tagOf_PrimOp FloatTanhOp = ILIT( 82)
\r
390 tagOf_PrimOp FloatPowerOp = ILIT( 83)
\r
392 tagOf_PrimOp DoubleAddOp = ILIT( 84)
\r
393 tagOf_PrimOp DoubleSubOp = ILIT( 85)
\r
394 tagOf_PrimOp DoubleMulOp = ILIT( 86)
\r
395 tagOf_PrimOp DoubleDivOp = ILIT( 87)
\r
396 tagOf_PrimOp DoubleNegOp = ILIT( 88)
\r
397 tagOf_PrimOp Double2IntOp = ILIT( 89)
\r
398 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
\r
399 tagOf_PrimOp Double2FloatOp = ILIT( 91)
\r
400 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
\r
401 tagOf_PrimOp DoubleExpOp = ILIT( 93)
\r
402 tagOf_PrimOp DoubleLogOp = ILIT( 94)
\r
403 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
\r
404 tagOf_PrimOp DoubleSinOp = ILIT( 96)
\r
405 tagOf_PrimOp DoubleCosOp = ILIT( 97)
\r
406 tagOf_PrimOp DoubleTanOp = ILIT( 98)
\r
407 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
\r
408 tagOf_PrimOp DoubleAcosOp = ILIT(100)
\r
409 tagOf_PrimOp DoubleAtanOp = ILIT(101)
\r
410 tagOf_PrimOp DoubleSinhOp = ILIT(102)
\r
411 tagOf_PrimOp DoubleCoshOp = ILIT(103)
\r
412 tagOf_PrimOp DoubleTanhOp = ILIT(104)
\r
413 tagOf_PrimOp DoublePowerOp = ILIT(105)
\r
415 tagOf_PrimOp IntegerAddOp = ILIT(106)
\r
416 tagOf_PrimOp IntegerSubOp = ILIT(107)
\r
417 tagOf_PrimOp IntegerMulOp = ILIT(108)
\r
418 tagOf_PrimOp IntegerGcdOp = ILIT(109)
\r
419 tagOf_PrimOp IntegerQuotRemOp = ILIT(110)
\r
420 tagOf_PrimOp IntegerDivModOp = ILIT(111)
\r
421 tagOf_PrimOp IntegerNegOp = ILIT(112)
\r
422 tagOf_PrimOp IntegerCmpOp = ILIT(113)
\r
423 tagOf_PrimOp IntegerCmpIntOp = ILIT(114)
\r
424 tagOf_PrimOp Integer2IntOp = ILIT(115)
\r
425 tagOf_PrimOp Integer2WordOp = ILIT(116)
\r
426 tagOf_PrimOp Int2IntegerOp = ILIT(117)
\r
427 tagOf_PrimOp Word2IntegerOp = ILIT(118)
\r
428 tagOf_PrimOp Addr2IntegerOp = ILIT(119)
\r
429 tagOf_PrimOp IntegerToInt64Op = ILIT(120)
\r
430 tagOf_PrimOp Int64ToIntegerOp = ILIT(121)
\r
431 tagOf_PrimOp IntegerToWord64Op = ILIT(122)
\r
432 tagOf_PrimOp Word64ToIntegerOp = ILIT(123)
\r
433 tagOf_PrimOp FloatDecodeOp = ILIT(125)
\r
434 tagOf_PrimOp DoubleDecodeOp = ILIT(127)
\r
436 tagOf_PrimOp NewArrayOp = ILIT(128)
\r
437 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129)
\r
438 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130)
\r
439 tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131)
\r
440 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132)
\r
441 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133)
\r
442 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134)
\r
443 tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135)
\r
445 tagOf_PrimOp SameMutableArrayOp = ILIT(136)
\r
446 tagOf_PrimOp SameMutableByteArrayOp = ILIT(137)
\r
447 tagOf_PrimOp ReadArrayOp = ILIT(138)
\r
448 tagOf_PrimOp WriteArrayOp = ILIT(139)
\r
449 tagOf_PrimOp IndexArrayOp = ILIT(140)
\r
451 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141)
\r
452 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142)
\r
453 tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143)
\r
454 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144)
\r
455 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145)
\r
456 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146)
\r
457 tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147)
\r
458 tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148)
\r
459 tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149)
\r
461 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150)
\r
462 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151)
\r
463 tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152)
\r
464 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153)
\r
465 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154)
\r
466 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155)
\r
467 tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156)
\r
468 tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157)
\r
469 tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158)
\r
471 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159)
\r
472 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160)
\r
473 tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161)
\r
474 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162)
\r
475 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163)
\r
476 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164)
\r
477 tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165)
\r
478 tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166)
\r
479 tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167)
\r
481 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168)
\r
482 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169)
\r
483 tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170)
\r
484 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171)
\r
485 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172)
\r
486 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173)
\r
487 tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174)
\r
488 tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175)
\r
489 tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176)
\r
491 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177)
\r
492 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178)
\r
493 tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179)
\r
494 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180)
\r
495 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181)
\r
496 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182)
\r
497 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183)
\r
498 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184)
\r
499 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185)
\r
501 tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186)
\r
502 tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187)
\r
503 tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188)
\r
504 tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189)
\r
505 tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190)
\r
506 tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191)
\r
507 tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192)
\r
508 tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193)
\r
509 tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194)
\r
510 tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195)
\r
512 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196)
\r
513 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197)
\r
514 tagOf_PrimOp UnsafeThawArrayOp = ILIT(198)
\r
515 tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199)
\r
516 tagOf_PrimOp SizeofByteArrayOp = ILIT(200)
\r
517 tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201)
\r
519 tagOf_PrimOp NewMVarOp = ILIT(202)
\r
520 tagOf_PrimOp TakeMVarOp = ILIT(203)
\r
521 tagOf_PrimOp PutMVarOp = ILIT(204)
\r
522 tagOf_PrimOp SameMVarOp = ILIT(205)
\r
523 tagOf_PrimOp IsEmptyMVarOp = ILIT(206)
\r
524 tagOf_PrimOp MakeForeignObjOp = ILIT(207)
\r
525 tagOf_PrimOp WriteForeignObjOp = ILIT(208)
\r
526 tagOf_PrimOp MkWeakOp = ILIT(209)
\r
527 tagOf_PrimOp DeRefWeakOp = ILIT(210)
\r
528 tagOf_PrimOp FinalizeWeakOp = ILIT(211)
\r
529 tagOf_PrimOp MakeStableNameOp = ILIT(212)
\r
530 tagOf_PrimOp EqStableNameOp = ILIT(213)
\r
531 tagOf_PrimOp StableNameToIntOp = ILIT(214)
\r
532 tagOf_PrimOp MakeStablePtrOp = ILIT(215)
\r
533 tagOf_PrimOp DeRefStablePtrOp = ILIT(216)
\r
534 tagOf_PrimOp EqStablePtrOp = ILIT(217)
\r
535 tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218)
\r
536 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219)
\r
537 tagOf_PrimOp SeqOp = ILIT(220)
\r
538 tagOf_PrimOp ParOp = ILIT(221)
\r
539 tagOf_PrimOp ForkOp = ILIT(222)
\r
540 tagOf_PrimOp KillThreadOp = ILIT(223)
\r
541 tagOf_PrimOp YieldOp = ILIT(224)
\r
542 tagOf_PrimOp MyThreadIdOp = ILIT(225)
\r
543 tagOf_PrimOp DelayOp = ILIT(226)
\r
544 tagOf_PrimOp WaitReadOp = ILIT(227)
\r
545 tagOf_PrimOp WaitWriteOp = ILIT(228)
\r
546 tagOf_PrimOp ParGlobalOp = ILIT(229)
\r
547 tagOf_PrimOp ParLocalOp = ILIT(230)
\r
548 tagOf_PrimOp ParAtOp = ILIT(231)
\r
549 tagOf_PrimOp ParAtAbsOp = ILIT(232)
\r
550 tagOf_PrimOp ParAtRelOp = ILIT(233)
\r
551 tagOf_PrimOp ParAtForNowOp = ILIT(234)
\r
552 tagOf_PrimOp CopyableOp = ILIT(235)
\r
553 tagOf_PrimOp NoFollowOp = ILIT(236)
\r
554 tagOf_PrimOp NewMutVarOp = ILIT(237)
\r
555 tagOf_PrimOp ReadMutVarOp = ILIT(238)
\r
556 tagOf_PrimOp WriteMutVarOp = ILIT(239)
\r
557 tagOf_PrimOp SameMutVarOp = ILIT(240)
\r
558 tagOf_PrimOp CatchOp = ILIT(241)
\r
559 tagOf_PrimOp RaiseOp = ILIT(242)
\r
560 tagOf_PrimOp DataToTagOp = ILIT(243)
\r
561 tagOf_PrimOp TagToEnumOp = ILIT(244)
\r
563 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
\r
564 --panic# "tagOf_PrimOp: pattern-match"
\r
566 instance Eq PrimOp where
\r
567 op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
\r
569 instance Ord PrimOp where
\r
570 op1 < op2 = tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
\r
571 op1 <= op2 = tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
\r
572 op1 >= op2 = tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
\r
573 op1 > op2 = tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
\r
574 op1 `compare` op2 | op1 < op2 = LT
\r
578 instance Outputable PrimOp where
\r
579 ppr op = pprPrimOp op
\r
581 instance Show PrimOp where
\r
582 showsPrec p op = showsPrecSDoc p (pprPrimOp op)
\r
585 An @Enum@-derived list would be better; meanwhile... (ToDo)
\r
714 NewByteArrayOp CharRep,
\r
715 NewByteArrayOp IntRep,
\r
716 NewByteArrayOp WordRep,
\r
717 NewByteArrayOp AddrRep,
\r
718 NewByteArrayOp FloatRep,
\r
719 NewByteArrayOp DoubleRep,
\r
720 NewByteArrayOp StablePtrRep,
\r
721 SameMutableArrayOp,
\r
722 SameMutableByteArrayOp,
\r
726 ReadByteArrayOp CharRep,
\r
727 ReadByteArrayOp IntRep,
\r
728 ReadByteArrayOp WordRep,
\r
729 ReadByteArrayOp AddrRep,
\r
730 ReadByteArrayOp FloatRep,
\r
731 ReadByteArrayOp DoubleRep,
\r
732 ReadByteArrayOp StablePtrRep,
\r
733 ReadByteArrayOp Int64Rep,
\r
734 ReadByteArrayOp Word64Rep,
\r
735 WriteByteArrayOp CharRep,
\r
736 WriteByteArrayOp IntRep,
\r
737 WriteByteArrayOp WordRep,
\r
738 WriteByteArrayOp AddrRep,
\r
739 WriteByteArrayOp FloatRep,
\r
740 WriteByteArrayOp DoubleRep,
\r
741 WriteByteArrayOp StablePtrRep,
\r
742 WriteByteArrayOp Int64Rep,
\r
743 WriteByteArrayOp Word64Rep,
\r
744 IndexByteArrayOp CharRep,
\r
745 IndexByteArrayOp IntRep,
\r
746 IndexByteArrayOp WordRep,
\r
747 IndexByteArrayOp AddrRep,
\r
748 IndexByteArrayOp FloatRep,
\r
749 IndexByteArrayOp DoubleRep,
\r
750 IndexByteArrayOp StablePtrRep,
\r
751 IndexByteArrayOp Int64Rep,
\r
752 IndexByteArrayOp Word64Rep,
\r
753 IndexOffForeignObjOp CharRep,
\r
754 IndexOffForeignObjOp AddrRep,
\r
755 IndexOffForeignObjOp IntRep,
\r
756 IndexOffForeignObjOp WordRep,
\r
757 IndexOffForeignObjOp FloatRep,
\r
758 IndexOffForeignObjOp DoubleRep,
\r
759 IndexOffForeignObjOp StablePtrRep,
\r
760 IndexOffForeignObjOp Int64Rep,
\r
761 IndexOffForeignObjOp Word64Rep,
\r
762 IndexOffAddrOp CharRep,
\r
763 IndexOffAddrOp IntRep,
\r
764 IndexOffAddrOp WordRep,
\r
765 IndexOffAddrOp AddrRep,
\r
766 IndexOffAddrOp FloatRep,
\r
767 IndexOffAddrOp DoubleRep,
\r
768 IndexOffAddrOp StablePtrRep,
\r
769 IndexOffAddrOp Int64Rep,
\r
770 IndexOffAddrOp Word64Rep,
\r
771 WriteOffAddrOp CharRep,
\r
772 WriteOffAddrOp IntRep,
\r
773 WriteOffAddrOp WordRep,
\r
774 WriteOffAddrOp AddrRep,
\r
775 WriteOffAddrOp FloatRep,
\r
776 WriteOffAddrOp DoubleRep,
\r
777 WriteOffAddrOp ForeignObjRep,
\r
778 WriteOffAddrOp StablePtrRep,
\r
779 WriteOffAddrOp Int64Rep,
\r
780 WriteOffAddrOp Word64Rep,
\r
781 UnsafeFreezeArrayOp,
\r
782 UnsafeFreezeByteArrayOp,
\r
784 UnsafeThawByteArrayOp,
\r
786 SizeofMutableByteArrayOp,
\r
809 ReallyUnsafePtrEqualityOp,
\r
832 %************************************************************************
\r
834 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
\r
836 %************************************************************************
\r
838 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
\r
839 refer to the primitive operation. The conventional \tr{#}-for-
\r
840 unboxed ops is added on later.
\r
842 The reason for the funny characters in the names is so we do not
\r
843 interfere with the programmer's Haskell name spaces.
\r
845 We use @PrimKinds@ for the ``type'' information, because they're
\r
846 (slightly) more convenient to use than @TyCons@.
\r
849 = Dyadic OccName -- string :: T -> T -> T
\r
851 | Monadic OccName -- string :: T -> T
\r
853 | Compare OccName -- string :: T -> T -> Bool
\r
856 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
\r
861 mkDyadic str ty = Dyadic (mkSrcVarOcc str) ty
\r
862 mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
\r
863 mkCompare str ty = Compare (mkSrcVarOcc str) ty
\r
864 mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
\r
869 one_Integer_ty = [intPrimTy, byteArrayPrimTy]
\r
871 = [intPrimTy, byteArrayPrimTy, -- first Integer pieces
\r
872 intPrimTy, byteArrayPrimTy] -- second '' pieces
\r
873 an_Integer_and_Int_tys
\r
874 = [intPrimTy, byteArrayPrimTy, -- Integer
\r
877 unboxedPair = mkUnboxedTupleTy 2
\r
878 unboxedTriple = mkUnboxedTupleTy 3
\r
879 unboxedQuadruple = mkUnboxedTupleTy 4
\r
881 integerMonadic name = mkGenPrimOp name [] one_Integer_ty
\r
882 (unboxedPair one_Integer_ty)
\r
884 integerDyadic name = mkGenPrimOp name [] two_Integer_tys
\r
885 (unboxedPair one_Integer_ty)
\r
887 integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys
\r
888 (unboxedQuadruple two_Integer_tys)
\r
890 integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy
\r
893 %************************************************************************
\r
895 \subsubsection{Strictness}
\r
897 %************************************************************************
\r
899 Not all primops are strict!
\r
902 primOpStrictness :: PrimOp -> ([Demand], Bool)
\r
903 -- See IdInfo.StrictnessInfo for discussion of what the results
\r
904 -- **NB** as a cheap hack, to avoid having to look up the PrimOp's arity,
\r
905 -- the list of demands may be infinite!
\r
906 -- Use only the ones you ned.
\r
908 primOpStrictness SeqOp = ([wwStrict], False)
\r
909 -- Seq is strict in its argument; see notes in ConFold.lhs
\r
911 primOpStrictness ParOp = ([wwLazy], False)
\r
912 -- But Par is lazy, to avoid that the sparked thing
\r
913 -- gets evaluted strictly, which it should *not* be
\r
915 primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
\r
917 primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
\r
918 primOpStrictness WriteArrayOp = ([wwPrim, wwPrim, wwLazy, wwPrim], False)
\r
920 primOpStrictness NewMutVarOp = ([wwLazy, wwPrim], False)
\r
921 primOpStrictness WriteMutVarOp = ([wwPrim, wwLazy, wwPrim], False)
\r
923 primOpStrictness PutMVarOp = ([wwPrim, wwLazy, wwPrim], False)
\r
925 primOpStrictness CatchOp = ([wwLazy, wwLazy], False)
\r
926 primOpStrictness RaiseOp = ([wwLazy], True) -- NB: True => result is bottom
\r
928 primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False)
\r
929 primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False)
\r
930 primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False)
\r
932 primOpStrictness DataToTagOp = ([wwLazy], False)
\r
934 -- The rest all have primitive-typed arguments
\r
935 primOpStrictness other = (repeat wwPrim, False)
\r
938 %************************************************************************
\r
940 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
\r
942 %************************************************************************
\r
944 @primOpInfo@ gives all essential information (from which everything
\r
945 else, notably a type, can be constructed) for each @PrimOp@.
\r
948 primOpInfo :: PrimOp -> PrimOpInfo
\r
951 There's plenty of this stuff!
\r
954 primOpInfo CharGtOp = mkCompare SLIT("gtChar#") charPrimTy
\r
955 primOpInfo CharGeOp = mkCompare SLIT("geChar#") charPrimTy
\r
956 primOpInfo CharEqOp = mkCompare SLIT("eqChar#") charPrimTy
\r
957 primOpInfo CharNeOp = mkCompare SLIT("neChar#") charPrimTy
\r
958 primOpInfo CharLtOp = mkCompare SLIT("ltChar#") charPrimTy
\r
959 primOpInfo CharLeOp = mkCompare SLIT("leChar#") charPrimTy
\r
961 primOpInfo IntGtOp = mkCompare SLIT(">#") intPrimTy
\r
962 primOpInfo IntGeOp = mkCompare SLIT(">=#") intPrimTy
\r
963 primOpInfo IntEqOp = mkCompare SLIT("==#") intPrimTy
\r
964 primOpInfo IntNeOp = mkCompare SLIT("/=#") intPrimTy
\r
965 primOpInfo IntLtOp = mkCompare SLIT("<#") intPrimTy
\r
966 primOpInfo IntLeOp = mkCompare SLIT("<=#") intPrimTy
\r
968 primOpInfo WordGtOp = mkCompare SLIT("gtWord#") wordPrimTy
\r
969 primOpInfo WordGeOp = mkCompare SLIT("geWord#") wordPrimTy
\r
970 primOpInfo WordEqOp = mkCompare SLIT("eqWord#") wordPrimTy
\r
971 primOpInfo WordNeOp = mkCompare SLIT("neWord#") wordPrimTy
\r
972 primOpInfo WordLtOp = mkCompare SLIT("ltWord#") wordPrimTy
\r
973 primOpInfo WordLeOp = mkCompare SLIT("leWord#") wordPrimTy
\r
975 primOpInfo AddrGtOp = mkCompare SLIT("gtAddr#") addrPrimTy
\r
976 primOpInfo AddrGeOp = mkCompare SLIT("geAddr#") addrPrimTy
\r
977 primOpInfo AddrEqOp = mkCompare SLIT("eqAddr#") addrPrimTy
\r
978 primOpInfo AddrNeOp = mkCompare SLIT("neAddr#") addrPrimTy
\r
979 primOpInfo AddrLtOp = mkCompare SLIT("ltAddr#") addrPrimTy
\r
980 primOpInfo AddrLeOp = mkCompare SLIT("leAddr#") addrPrimTy
\r
982 primOpInfo FloatGtOp = mkCompare SLIT("gtFloat#") floatPrimTy
\r
983 primOpInfo FloatGeOp = mkCompare SLIT("geFloat#") floatPrimTy
\r
984 primOpInfo FloatEqOp = mkCompare SLIT("eqFloat#") floatPrimTy
\r
985 primOpInfo FloatNeOp = mkCompare SLIT("neFloat#") floatPrimTy
\r
986 primOpInfo FloatLtOp = mkCompare SLIT("ltFloat#") floatPrimTy
\r
987 primOpInfo FloatLeOp = mkCompare SLIT("leFloat#") floatPrimTy
\r
989 primOpInfo DoubleGtOp = mkCompare SLIT(">##") doublePrimTy
\r
990 primOpInfo DoubleGeOp = mkCompare SLIT(">=##") doublePrimTy
\r
991 primOpInfo DoubleEqOp = mkCompare SLIT("==##") doublePrimTy
\r
992 primOpInfo DoubleNeOp = mkCompare SLIT("/=##") doublePrimTy
\r
993 primOpInfo DoubleLtOp = mkCompare SLIT("<##") doublePrimTy
\r
994 primOpInfo DoubleLeOp = mkCompare SLIT("<=##") doublePrimTy
\r
998 %************************************************************************
\r
1000 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
\r
1002 %************************************************************************
\r
1005 primOpInfo OrdOp = mkGenPrimOp SLIT("ord#") [] [charPrimTy] intPrimTy
\r
1006 primOpInfo ChrOp = mkGenPrimOp SLIT("chr#") [] [intPrimTy] charPrimTy
\r
1009 %************************************************************************
\r
1011 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
\r
1013 %************************************************************************
\r
1016 primOpInfo IntAddOp = mkDyadic SLIT("+#") intPrimTy
\r
1017 primOpInfo IntSubOp = mkDyadic SLIT("-#") intPrimTy
\r
1018 primOpInfo IntMulOp = mkDyadic SLIT("*#") intPrimTy
\r
1019 primOpInfo IntQuotOp = mkDyadic SLIT("quotInt#") intPrimTy
\r
1020 primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy
\r
1022 primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy
\r
1023 primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy
\r
1025 primOpInfo IntAddCOp =
\r
1026 mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy]
\r
1027 (unboxedPair [intPrimTy, intPrimTy])
\r
1029 primOpInfo IntSubCOp =
\r
1030 mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy]
\r
1031 (unboxedPair [intPrimTy, intPrimTy])
\r
1033 primOpInfo IntMulCOp =
\r
1034 mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy]
\r
1035 (unboxedPair [intPrimTy, intPrimTy])
\r
1038 %************************************************************************
\r
1040 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
\r
1042 %************************************************************************
\r
1044 A @Word#@ is an unsigned @Int#@.
\r
1047 primOpInfo WordQuotOp = mkDyadic SLIT("quotWord#") wordPrimTy
\r
1048 primOpInfo WordRemOp = mkDyadic SLIT("remWord#") wordPrimTy
\r
1050 primOpInfo AndOp = mkDyadic SLIT("and#") wordPrimTy
\r
1051 primOpInfo OrOp = mkDyadic SLIT("or#") wordPrimTy
\r
1052 primOpInfo XorOp = mkDyadic SLIT("xor#") wordPrimTy
\r
1053 primOpInfo NotOp = mkMonadic SLIT("not#") wordPrimTy
\r
1056 = mkGenPrimOp SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTy
\r
1058 = mkGenPrimOp SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTy
\r
1061 = mkGenPrimOp SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTy
\r
1063 = mkGenPrimOp SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTy
\r
1065 = mkGenPrimOp SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTy
\r
1067 primOpInfo Int2WordOp = mkGenPrimOp SLIT("int2Word#") [] [intPrimTy] wordPrimTy
\r
1068 primOpInfo Word2IntOp = mkGenPrimOp SLIT("word2Int#") [] [wordPrimTy] intPrimTy
\r
1071 %************************************************************************
\r
1073 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
\r
1075 %************************************************************************
\r
1078 primOpInfo Int2AddrOp = mkGenPrimOp SLIT("int2Addr#") [] [intPrimTy] addrPrimTy
\r
1079 primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy
\r
1083 %************************************************************************
\r
1085 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
\r
1087 %************************************************************************
\r
1089 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
\r
1092 primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy
\r
1093 primOpInfo FloatSubOp = mkDyadic SLIT("minusFloat#") floatPrimTy
\r
1094 primOpInfo FloatMulOp = mkDyadic SLIT("timesFloat#") floatPrimTy
\r
1095 primOpInfo FloatDivOp = mkDyadic SLIT("divideFloat#") floatPrimTy
\r
1096 primOpInfo FloatNegOp = mkMonadic SLIT("negateFloat#") floatPrimTy
\r
1098 primOpInfo Float2IntOp = mkGenPrimOp SLIT("float2Int#") [] [floatPrimTy] intPrimTy
\r
1099 primOpInfo Int2FloatOp = mkGenPrimOp SLIT("int2Float#") [] [intPrimTy] floatPrimTy
\r
1101 primOpInfo FloatExpOp = mkMonadic SLIT("expFloat#") floatPrimTy
\r
1102 primOpInfo FloatLogOp = mkMonadic SLIT("logFloat#") floatPrimTy
\r
1103 primOpInfo FloatSqrtOp = mkMonadic SLIT("sqrtFloat#") floatPrimTy
\r
1104 primOpInfo FloatSinOp = mkMonadic SLIT("sinFloat#") floatPrimTy
\r
1105 primOpInfo FloatCosOp = mkMonadic SLIT("cosFloat#") floatPrimTy
\r
1106 primOpInfo FloatTanOp = mkMonadic SLIT("tanFloat#") floatPrimTy
\r
1107 primOpInfo FloatAsinOp = mkMonadic SLIT("asinFloat#") floatPrimTy
\r
1108 primOpInfo FloatAcosOp = mkMonadic SLIT("acosFloat#") floatPrimTy
\r
1109 primOpInfo FloatAtanOp = mkMonadic SLIT("atanFloat#") floatPrimTy
\r
1110 primOpInfo FloatSinhOp = mkMonadic SLIT("sinhFloat#") floatPrimTy
\r
1111 primOpInfo FloatCoshOp = mkMonadic SLIT("coshFloat#") floatPrimTy
\r
1112 primOpInfo FloatTanhOp = mkMonadic SLIT("tanhFloat#") floatPrimTy
\r
1113 primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy
\r
1116 %************************************************************************
\r
1118 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
\r
1120 %************************************************************************
\r
1122 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
\r
1125 primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy
\r
1126 primOpInfo DoubleSubOp = mkDyadic SLIT("-##") doublePrimTy
\r
1127 primOpInfo DoubleMulOp = mkDyadic SLIT("*##") doublePrimTy
\r
1128 primOpInfo DoubleDivOp = mkDyadic SLIT("/##") doublePrimTy
\r
1129 primOpInfo DoubleNegOp = mkMonadic SLIT("negateDouble#") doublePrimTy
\r
1131 primOpInfo Double2IntOp = mkGenPrimOp SLIT("double2Int#") [] [doublePrimTy] intPrimTy
\r
1132 primOpInfo Int2DoubleOp = mkGenPrimOp SLIT("int2Double#") [] [intPrimTy] doublePrimTy
\r
1134 primOpInfo Double2FloatOp = mkGenPrimOp SLIT("double2Float#") [] [doublePrimTy] floatPrimTy
\r
1135 primOpInfo Float2DoubleOp = mkGenPrimOp SLIT("float2Double#") [] [floatPrimTy] doublePrimTy
\r
1137 primOpInfo DoubleExpOp = mkMonadic SLIT("expDouble#") doublePrimTy
\r
1138 primOpInfo DoubleLogOp = mkMonadic SLIT("logDouble#") doublePrimTy
\r
1139 primOpInfo DoubleSqrtOp = mkMonadic SLIT("sqrtDouble#") doublePrimTy
\r
1140 primOpInfo DoubleSinOp = mkMonadic SLIT("sinDouble#") doublePrimTy
\r
1141 primOpInfo DoubleCosOp = mkMonadic SLIT("cosDouble#") doublePrimTy
\r
1142 primOpInfo DoubleTanOp = mkMonadic SLIT("tanDouble#") doublePrimTy
\r
1143 primOpInfo DoubleAsinOp = mkMonadic SLIT("asinDouble#") doublePrimTy
\r
1144 primOpInfo DoubleAcosOp = mkMonadic SLIT("acosDouble#") doublePrimTy
\r
1145 primOpInfo DoubleAtanOp = mkMonadic SLIT("atanDouble#") doublePrimTy
\r
1146 primOpInfo DoubleSinhOp = mkMonadic SLIT("sinhDouble#") doublePrimTy
\r
1147 primOpInfo DoubleCoshOp = mkMonadic SLIT("coshDouble#") doublePrimTy
\r
1148 primOpInfo DoubleTanhOp = mkMonadic SLIT("tanhDouble#") doublePrimTy
\r
1149 primOpInfo DoublePowerOp= mkDyadic SLIT("**##") doublePrimTy
\r
1152 %************************************************************************
\r
1154 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
\r
1156 %************************************************************************
\r
1159 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
\r
1161 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
\r
1162 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
\r
1163 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
\r
1164 primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#")
\r
1166 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
\r
1167 primOpInfo IntegerCmpIntOp
\r
1168 = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy
\r
1170 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
\r
1171 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
\r
1173 primOpInfo Integer2IntOp
\r
1174 = mkGenPrimOp SLIT("integer2Int#") [] one_Integer_ty intPrimTy
\r
1176 primOpInfo Integer2WordOp
\r
1177 = mkGenPrimOp SLIT("integer2Word#") [] one_Integer_ty wordPrimTy
\r
1179 primOpInfo Int2IntegerOp
\r
1180 = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy]
\r
1181 (unboxedPair one_Integer_ty)
\r
1183 primOpInfo Word2IntegerOp
\r
1184 = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy]
\r
1185 (unboxedPair one_Integer_ty)
\r
1187 primOpInfo Addr2IntegerOp
\r
1188 = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy]
\r
1189 (unboxedPair one_Integer_ty)
\r
1191 primOpInfo IntegerToInt64Op
\r
1192 = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy
\r
1194 primOpInfo Int64ToIntegerOp
\r
1195 = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy]
\r
1196 (unboxedPair one_Integer_ty)
\r
1198 primOpInfo Word64ToIntegerOp
\r
1199 = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy]
\r
1200 (unboxedPair one_Integer_ty)
\r
1202 primOpInfo IntegerToWord64Op
\r
1203 = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy
\r
1206 Decoding of floating-point numbers is sorta Integer-related. Encoding
\r
1207 is done with plain ccalls now (see PrelNumExtra.lhs).
\r
1210 primOpInfo FloatDecodeOp
\r
1211 = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy]
\r
1212 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
\r
1213 primOpInfo DoubleDecodeOp
\r
1214 = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy]
\r
1215 (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy])
\r
1218 %************************************************************************
\r
1220 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
\r
1222 %************************************************************************
\r
1225 newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #)
\r
1226 newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #)
\r
1230 primOpInfo NewArrayOp
\r
1232 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1233 state = mkStatePrimTy s
\r
1235 mkGenPrimOp SLIT("newArray#") [s_tv, elt_tv]
\r
1236 [intPrimTy, elt, state]
\r
1237 (unboxedPair [state, mkMutableArrayPrimTy s elt])
\r
1239 primOpInfo (NewByteArrayOp kind)
\r
1241 s = alphaTy; s_tv = alphaTyVar
\r
1243 op_str = _PK_ ("new" ++ primRepString kind ++ "Array#")
\r
1244 state = mkStatePrimTy s
\r
1246 mkGenPrimOp op_str [s_tv]
\r
1247 [intPrimTy, state]
\r
1248 (unboxedPair [state, mkMutableByteArrayPrimTy s])
\r
1250 ---------------------------------------------------------------------------
\r
1253 sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool
\r
1254 sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool
\r
1257 primOpInfo SameMutableArrayOp
\r
1259 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1260 mut_arr_ty = mkMutableArrayPrimTy s elt
\r
1262 mkGenPrimOp SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
\r
1265 primOpInfo SameMutableByteArrayOp
\r
1267 s = alphaTy; s_tv = alphaTyVar;
\r
1268 mut_arr_ty = mkMutableByteArrayPrimTy s
\r
1270 mkGenPrimOp SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
\r
1273 ---------------------------------------------------------------------------
\r
1274 -- Primitive arrays of Haskell pointers:
\r
1277 readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #)
\r
1278 writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s
\r
1279 indexArray# :: Array# a -> Int# -> (# a #)
\r
1282 primOpInfo ReadArrayOp
\r
1284 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1285 state = mkStatePrimTy s
\r
1287 mkGenPrimOp SLIT("readArray#") [s_tv, elt_tv]
\r
1288 [mkMutableArrayPrimTy s elt, intPrimTy, state]
\r
1289 (unboxedPair [state, elt])
\r
1292 primOpInfo WriteArrayOp
\r
1294 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1296 mkGenPrimOp SLIT("writeArray#") [s_tv, elt_tv]
\r
1297 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
\r
1300 primOpInfo IndexArrayOp
\r
1301 = let { elt = alphaTy; elt_tv = alphaTyVar } in
\r
1302 mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
\r
1303 (mkUnboxedTupleTy 1 [elt])
\r
1305 ---------------------------------------------------------------------------
\r
1306 -- Primitive arrays full of unboxed bytes:
\r
1308 primOpInfo (ReadByteArrayOp kind)
\r
1310 s = alphaTy; s_tv = alphaTyVar
\r
1312 op_str = _PK_ ("read" ++ primRepString kind ++ "Array#")
\r
1313 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
\r
1314 state = mkStatePrimTy s
\r
1316 mkGenPrimOp op_str (s_tv:tvs)
\r
1317 [mkMutableByteArrayPrimTy s, intPrimTy, state]
\r
1318 (unboxedPair [state, prim_ty])
\r
1320 primOpInfo (WriteByteArrayOp kind)
\r
1322 s = alphaTy; s_tv = alphaTyVar
\r
1323 op_str = _PK_ ("write" ++ primRepString kind ++ "Array#")
\r
1324 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
\r
1326 mkGenPrimOp op_str (s_tv:tvs)
\r
1327 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
\r
1330 primOpInfo (IndexByteArrayOp kind)
\r
1332 op_str = _PK_ ("index" ++ primRepString kind ++ "Array#")
\r
1333 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
\r
1335 mkGenPrimOp op_str tvs [byteArrayPrimTy, intPrimTy] prim_ty
\r
1337 primOpInfo (IndexOffForeignObjOp kind)
\r
1339 op_str = _PK_ ("index" ++ primRepString kind ++ "OffForeignObj#")
\r
1340 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
\r
1342 mkGenPrimOp op_str tvs [foreignObjPrimTy, intPrimTy] prim_ty
\r
1344 primOpInfo (IndexOffAddrOp kind)
\r
1346 op_str = _PK_ ("index" ++ primRepString kind ++ "OffAddr#")
\r
1347 (tvs, prim_ty) = mkPrimTyApp alphaTyVars kind
\r
1349 mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
\r
1351 primOpInfo (WriteOffAddrOp kind)
\r
1353 s = alphaTy; s_tv = alphaTyVar
\r
1354 op_str = _PK_ ("write" ++ primRepString kind ++ "OffAddr#")
\r
1355 (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
\r
1357 mkGenPrimOp op_str (s_tv:tvs)
\r
1358 [addrPrimTy, intPrimTy, prim_ty, mkStatePrimTy s]
\r
1361 ---------------------------------------------------------------------------
\r
1363 unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #)
\r
1364 unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #)
\r
1365 unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #)
\r
1366 unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #)
\r
1369 primOpInfo UnsafeFreezeArrayOp
\r
1371 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1372 state = mkStatePrimTy s
\r
1374 mkGenPrimOp SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
\r
1375 [mkMutableArrayPrimTy s elt, state]
\r
1376 (unboxedPair [state, mkArrayPrimTy elt])
\r
1378 primOpInfo UnsafeFreezeByteArrayOp
\r
1380 s = alphaTy; s_tv = alphaTyVar;
\r
1381 state = mkStatePrimTy s
\r
1383 mkGenPrimOp SLIT("unsafeFreezeByteArray#") [s_tv]
\r
1384 [mkMutableByteArrayPrimTy s, state]
\r
1385 (unboxedPair [state, byteArrayPrimTy])
\r
1387 primOpInfo UnsafeThawArrayOp
\r
1389 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1390 state = mkStatePrimTy s
\r
1392 mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv]
\r
1393 [mkArrayPrimTy elt, state]
\r
1394 (unboxedPair [state, mkMutableArrayPrimTy s elt])
\r
1396 primOpInfo UnsafeThawByteArrayOp
\r
1398 s = alphaTy; s_tv = alphaTyVar;
\r
1399 state = mkStatePrimTy s
\r
1401 mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv]
\r
1402 [byteArrayPrimTy, state]
\r
1403 (unboxedPair [state, mkMutableByteArrayPrimTy s])
\r
1405 ---------------------------------------------------------------------------
\r
1406 primOpInfo SizeofByteArrayOp
\r
1408 SLIT("sizeofByteArray#") []
\r
1412 primOpInfo SizeofMutableByteArrayOp
\r
1413 = let { s = alphaTy; s_tv = alphaTyVar } in
\r
1415 SLIT("sizeofMutableByteArray#") [s_tv]
\r
1416 [mkMutableByteArrayPrimTy s]
\r
1421 %************************************************************************
\r
1423 \subsubsection[PrimOp-MutVars]{PrimOpInfo for mutable variable ops}
\r
1425 %************************************************************************
\r
1428 primOpInfo NewMutVarOp
\r
1430 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1431 state = mkStatePrimTy s
\r
1433 mkGenPrimOp SLIT("newMutVar#") [s_tv, elt_tv]
\r
1435 (unboxedPair [state, mkMutVarPrimTy s elt])
\r
1437 primOpInfo ReadMutVarOp
\r
1439 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1440 state = mkStatePrimTy s
\r
1442 mkGenPrimOp SLIT("readMutVar#") [s_tv, elt_tv]
\r
1443 [mkMutVarPrimTy s elt, state]
\r
1444 (unboxedPair [state, elt])
\r
1447 primOpInfo WriteMutVarOp
\r
1449 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1451 mkGenPrimOp SLIT("writeMutVar#") [s_tv, elt_tv]
\r
1452 [mkMutVarPrimTy s elt, elt, mkStatePrimTy s]
\r
1455 primOpInfo SameMutVarOp
\r
1457 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
\r
1458 mut_var_ty = mkMutVarPrimTy s elt
\r
1460 mkGenPrimOp SLIT("sameMutVar#") [s_tv, elt_tv] [mut_var_ty, mut_var_ty]
\r
1464 %************************************************************************
\r
1466 \subsubsection[PrimOp-Exceptions]{PrimOpInfo for exceptions}
\r
1468 %************************************************************************
\r
1470 catch :: IO a -> (IOError -> IO a) -> IO a
\r
1471 catch# :: a -> (b -> a) -> a
\r
1474 primOpInfo CatchOp
\r
1476 a = alphaTy; a_tv = alphaTyVar
\r
1477 b = betaTy; b_tv = betaTyVar;
\r
1479 mkGenPrimOp SLIT("catch#") [a_tv, b_tv] [a, mkFunTy b a] a
\r
1481 primOpInfo RaiseOp
\r
1483 a = alphaTy; a_tv = alphaTyVar
\r
1484 b = betaTy; b_tv = betaTyVar;
\r
1486 mkGenPrimOp SLIT("raise#") [a_tv, b_tv] [a] b
\r
1489 %************************************************************************
\r
1491 \subsubsection[PrimOp-MVars]{PrimOpInfo for synchronizing Variables}
\r
1493 %************************************************************************
\r
1496 primOpInfo NewMVarOp
\r
1498 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1499 state = mkStatePrimTy s
\r
1501 mkGenPrimOp SLIT("newMVar#") [s_tv, elt_tv] [state]
\r
1502 (unboxedPair [state, mkMVarPrimTy s elt])
\r
1504 primOpInfo TakeMVarOp
\r
1506 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1507 state = mkStatePrimTy s
\r
1509 mkGenPrimOp SLIT("takeMVar#") [s_tv, elt_tv]
\r
1510 [mkMVarPrimTy s elt, state]
\r
1511 (unboxedPair [state, elt])
\r
1513 primOpInfo PutMVarOp
\r
1515 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1517 mkGenPrimOp SLIT("putMVar#") [s_tv, elt_tv]
\r
1518 [mkMVarPrimTy s elt, elt, mkStatePrimTy s]
\r
1521 primOpInfo SameMVarOp
\r
1523 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1524 mvar_ty = mkMVarPrimTy s elt
\r
1526 mkGenPrimOp SLIT("sameMVar#") [s_tv, elt_tv] [mvar_ty, mvar_ty] boolTy
\r
1528 primOpInfo IsEmptyMVarOp
\r
1530 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
\r
1531 state = mkStatePrimTy s
\r
1533 mkGenPrimOp SLIT("isEmptyMVar#") [s_tv, elt_tv]
\r
1534 [mkMVarPrimTy s elt, mkStatePrimTy s]
\r
1535 (unboxedPair [state, intPrimTy])
\r
1539 %************************************************************************
\r
1541 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
\r
1543 %************************************************************************
\r
1547 primOpInfo DelayOp
\r
1549 s = alphaTy; s_tv = alphaTyVar
\r
1551 mkGenPrimOp SLIT("delay#") [s_tv]
\r
1552 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\r
1554 primOpInfo WaitReadOp
\r
1556 s = alphaTy; s_tv = alphaTyVar
\r
1558 mkGenPrimOp SLIT("waitRead#") [s_tv]
\r
1559 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\r
1561 primOpInfo WaitWriteOp
\r
1563 s = alphaTy; s_tv = alphaTyVar
\r
1565 mkGenPrimOp SLIT("waitWrite#") [s_tv]
\r
1566 [intPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\r
1569 %************************************************************************
\r
1571 \subsubsection[PrimOp-Concurrency]{Concurrency Primitives}
\r
1573 %************************************************************************
\r
1576 -- fork# :: a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
\r
1577 primOpInfo ForkOp
\r
1578 = mkGenPrimOp SLIT("fork#") [alphaTyVar]
\r
1579 [alphaTy, realWorldStatePrimTy]
\r
1580 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
\r
1582 -- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld
\r
1583 primOpInfo KillThreadOp
\r
1584 = mkGenPrimOp SLIT("killThread#") [alphaTyVar]
\r
1585 [threadIdPrimTy, alphaTy, realWorldStatePrimTy]
\r
1586 realWorldStatePrimTy
\r
1588 -- yield# :: State# RealWorld -> State# RealWorld
\r
1589 primOpInfo YieldOp
\r
1590 = mkGenPrimOp SLIT("yield#") []
\r
1591 [realWorldStatePrimTy]
\r
1592 realWorldStatePrimTy
\r
1594 -- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #)
\r
1595 primOpInfo MyThreadIdOp
\r
1596 = mkGenPrimOp SLIT("myThreadId#") []
\r
1597 [realWorldStatePrimTy]
\r
1598 (unboxedPair [realWorldStatePrimTy, threadIdPrimTy])
\r
1601 ************************************************************************
\r
1603 \subsubsection[PrimOps-Foreign]{PrimOpInfo for Foreign Objects}
\r
1605 %************************************************************************
\r
1608 primOpInfo MakeForeignObjOp
\r
1609 = mkGenPrimOp SLIT("makeForeignObj#") []
\r
1610 [addrPrimTy, realWorldStatePrimTy]
\r
1611 (unboxedPair [realWorldStatePrimTy, foreignObjPrimTy])
\r
1613 primOpInfo WriteForeignObjOp
\r
1615 s = alphaTy; s_tv = alphaTyVar
\r
1617 mkGenPrimOp SLIT("writeForeignObj#") [s_tv]
\r
1618 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s] (mkStatePrimTy s)
\r
1621 ************************************************************************
\r
1623 \subsubsection[PrimOps-Weak]{PrimOpInfo for Weak Pointers}
\r
1625 %************************************************************************
\r
1627 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
\r
1629 mkWeak# :: k -> v -> f -> State# RealWorld
\r
1630 -> (# State# RealWorld, Weak# v #)
\r
1632 In practice, you'll use the higher-level
\r
1634 data Weak v = Weak# v
\r
1635 mkWeak :: k -> v -> IO () -> IO (Weak v)
\r
1638 primOpInfo MkWeakOp
\r
1639 = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
\r
1640 [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
\r
1641 (unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
\r
1644 The following operation dereferences a weak pointer. The weak pointer
\r
1645 may have been finalized, so the operation returns a result code which
\r
1646 must be inspected before looking at the dereferenced value.
\r
1648 deRefWeak# :: Weak# v -> State# RealWorld ->
\r
1649 (# State# RealWorld, v, Int# #)
\r
1651 Only look at v if the Int# returned is /= 0 !!
\r
1653 The higher-level op is
\r
1655 deRefWeak :: Weak v -> IO (Maybe v)
\r
1658 primOpInfo DeRefWeakOp
\r
1659 = mkGenPrimOp SLIT("deRefWeak#") [alphaTyVar]
\r
1660 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
\r
1661 (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy])
\r
1664 Weak pointers can be finalized early by using the finalize# operation:
\r
1666 finalizeWeak# :: Weak# v -> State# RealWorld ->
\r
1667 (# State# RealWorld, Int#, IO () #)
\r
1669 The Int# returned is either
\r
1671 0 if the weak pointer has already been finalized, or it has no
\r
1672 finalizer (the third component is then invalid).
\r
1674 1 if the weak pointer is still alive, with the finalizer returned
\r
1675 as the third component.
\r
1678 primOpInfo FinalizeWeakOp
\r
1679 = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar]
\r
1680 [mkWeakPrimTy alphaTy, realWorldStatePrimTy]
\r
1681 (unboxedTriple [realWorldStatePrimTy, intPrimTy,
\r
1682 mkFunTy realWorldStatePrimTy
\r
1683 (unboxedPair [realWorldStatePrimTy,unitTy])])
\r
1686 %************************************************************************
\r
1688 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for stable pointers and stable names}
\r
1690 %************************************************************************
\r
1692 A {\em stable name/pointer} is an index into a table of stable name
\r
1693 entries. Since the garbage collector is told about stable pointers,
\r
1694 it is safe to pass a stable pointer to external systems such as C
\r
1698 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
\r
1699 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
\r
1700 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
\r
1701 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
\r
1704 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
\r
1705 operation since it doesn't (directly) involve IO operations. The
\r
1706 reason is that if some optimisation pass decided to duplicate calls to
\r
1707 @makeStablePtr#@ and we only pass one of the stable pointers over, a
\r
1708 massive space leak can result. Putting it into the IO monad
\r
1709 prevents this. (Another reason for putting them in a monad is to
\r
1710 ensure correct sequencing wrt the side-effecting @freeStablePtr@
\r
1713 An important property of stable pointers is that if you call
\r
1714 makeStablePtr# twice on the same object you get the same stable
\r
1717 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
\r
1718 besides, it's not likely to be used from Haskell) so it's not a
\r
1721 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
\r
1726 A stable name is like a stable pointer, but with three important differences:
\r
1728 (a) You can't deRef one to get back to the original object.
\r
1729 (b) You can convert one to an Int.
\r
1730 (c) You don't need to 'freeStableName'
\r
1732 The existence of a stable name doesn't guarantee to keep the object it
\r
1733 points to alive (unlike a stable pointer), hence (a).
\r
1737 (a) makeStableName always returns the same value for a given
\r
1738 object (same as stable pointers).
\r
1740 (b) if two stable names are equal, it implies that the objects
\r
1741 from which they were created were the same.
\r
1743 (c) stableNameToInt always returns the same Int for a given
\r
1747 primOpInfo MakeStablePtrOp
\r
1748 = mkGenPrimOp SLIT("makeStablePtr#") [alphaTyVar]
\r
1749 [alphaTy, realWorldStatePrimTy]
\r
1750 (unboxedPair [realWorldStatePrimTy,
\r
1751 mkTyConApp stablePtrPrimTyCon [alphaTy]])
\r
1753 primOpInfo DeRefStablePtrOp
\r
1754 = mkGenPrimOp SLIT("deRefStablePtr#") [alphaTyVar]
\r
1755 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
\r
1756 (unboxedPair [realWorldStatePrimTy, alphaTy])
\r
1758 primOpInfo EqStablePtrOp
\r
1759 = mkGenPrimOp SLIT("eqStablePtr#") [alphaTyVar, betaTyVar]
\r
1760 [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy betaTy]
\r
1763 primOpInfo MakeStableNameOp
\r
1764 = mkGenPrimOp SLIT("makeStableName#") [alphaTyVar]
\r
1765 [alphaTy, realWorldStatePrimTy]
\r
1766 (unboxedPair [realWorldStatePrimTy,
\r
1767 mkTyConApp stableNamePrimTyCon [alphaTy]])
\r
1769 primOpInfo EqStableNameOp
\r
1770 = mkGenPrimOp SLIT("eqStableName#") [alphaTyVar, betaTyVar]
\r
1771 [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy]
\r
1774 primOpInfo StableNameToIntOp
\r
1775 = mkGenPrimOp SLIT("stableNameToInt#") [alphaTyVar]
\r
1776 [mkStableNamePrimTy alphaTy]
\r
1780 %************************************************************************
\r
1782 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
\r
1784 %************************************************************************
\r
1786 [Alastair Reid is to blame for this!]
\r
1788 These days, (Glasgow) Haskell seems to have a bit of everything from
\r
1789 other languages: strict operations, mutable variables, sequencing,
\r
1790 pointers, etc. About the only thing left is LISP's ability to test
\r
1791 for pointer equality. So, let's add it in!
\r
1794 reallyUnsafePtrEquality :: a -> a -> Int#
\r
1797 which tests any two closures (of the same type) to see if they're the
\r
1798 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
\r
1799 difficulties of trying to box up the result.)
\r
1801 NB This is {\em really unsafe\/} because even something as trivial as
\r
1802 a garbage collection might change the answer by removing indirections.
\r
1803 Still, no-one's forcing you to use it. If you're worried about little
\r
1804 things like loss of referential transparency, you might like to wrap
\r
1805 it all up in a monad-like thing as John O'Donnell and John Hughes did
\r
1806 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
\r
1809 I'm thinking of using it to speed up a critical equality test in some
\r
1810 graphics stuff in a context where the possibility of saying that
\r
1811 denotationally equal things aren't isn't a problem (as long as it
\r
1812 doesn't happen too often.) ADR
\r
1814 To Will: Jim said this was already in, but I can't see it so I'm
\r
1815 adding it. Up to you whether you add it. (Note that this could have
\r
1816 been readily implemented using a @veryDangerousCCall@ before they were
\r
1820 primOpInfo ReallyUnsafePtrEqualityOp
\r
1821 = mkGenPrimOp SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
\r
1822 [alphaTy, alphaTy] intPrimTy
\r
1825 %************************************************************************
\r
1827 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
\r
1829 %************************************************************************
\r
1832 primOpInfo SeqOp -- seq# :: a -> Int#
\r
1833 = mkGenPrimOp SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTy
\r
1835 primOpInfo ParOp -- par# :: a -> Int#
\r
1836 = mkGenPrimOp SLIT("par#") [alphaTyVar] [alphaTy] intPrimTy
\r
1840 -- HWL: The first 4 Int# in all par... annotations denote:
\r
1841 -- name, granularity info, size of result, degree of parallelism
\r
1842 -- Same structure as _seq_ i.e. returns Int#
\r
1843 -- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
\r
1844 -- `the processor containing the expression v'; it is not evaluated
\r
1846 primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1847 = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
\r
1849 primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1850 = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
\r
1852 primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1853 = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
\r
1855 primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1856 = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
\r
1858 primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1859 = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy
\r
1861 primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int#
\r
1862 = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy
\r
1864 primOpInfo CopyableOp -- copyable# :: a -> Int#
\r
1865 = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy
\r
1867 primOpInfo NoFollowOp -- noFollow# :: a -> Int#
\r
1868 = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy
\r
1871 %************************************************************************
\r
1873 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
\r
1875 %************************************************************************
\r
1878 primOpInfo (CCallOp _ _ _ _)
\r
1879 = mkGenPrimOp SLIT("ccall#") [alphaTyVar] [] alphaTy
\r
1882 primOpInfo (CCallOp _ _ _ _ arg_tys result_ty)
\r
1883 = mkGenPrimOp SLIT("ccall#") [] arg_tys result_tycon tys_applied
\r
1885 (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
\r
1889 %************************************************************************
\r
1891 \subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@}
\r
1893 %************************************************************************
\r
1895 These primops are pretty wierd.
\r
1897 dataToTag# :: a -> Int (arg must be an evaluated data type)
\r
1898 tagToEnum# :: Int -> a (result type must be an enumerated type)
\r
1900 The constraints aren't currently checked by the front end, but the
\r
1901 code generator will fall over if they aren't satisfied.
\r
1904 primOpInfo DataToTagOp
\r
1905 = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy
\r
1907 primOpInfo TagToEnumOp
\r
1908 = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy
\r
1911 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
\r
1915 %************************************************************************
\r
1917 \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
\r
1919 %************************************************************************
\r
1921 Some PrimOps need to be called out-of-line because they either need to
\r
1922 perform a heap check or they block.
\r
1925 primOpOutOfLine op
\r
1927 TakeMVarOp -> True
\r
1930 WaitReadOp -> True
\r
1931 WaitWriteOp -> True
\r
1934 NewArrayOp -> True
\r
1935 NewByteArrayOp _ -> True
\r
1936 IntegerAddOp -> True
\r
1937 IntegerSubOp -> True
\r
1938 IntegerMulOp -> True
\r
1939 IntegerGcdOp -> True
\r
1940 IntegerQuotRemOp -> True
\r
1941 IntegerDivModOp -> True
\r
1942 Int2IntegerOp -> True
\r
1943 Word2IntegerOp -> True
\r
1944 Addr2IntegerOp -> True
\r
1945 Word64ToIntegerOp -> True
\r
1946 Int64ToIntegerOp -> True
\r
1947 FloatDecodeOp -> True
\r
1948 DoubleDecodeOp -> True
\r
1950 FinalizeWeakOp -> True
\r
1951 MakeStableNameOp -> True
\r
1952 MakeForeignObjOp -> True
\r
1953 NewMutVarOp -> True
\r
1956 KillThreadOp -> True
\r
1958 CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_
\r
1959 -- the next one doesn't perform any heap checks,
\r
1960 -- but it is of such an esoteric nature that
\r
1961 -- it is done out-of-line rather than require
\r
1962 -- the NCG to implement it.
\r
1963 UnsafeThawArrayOp -> True
\r
1967 Sometimes we may choose to execute a PrimOp even though it isn't
\r
1968 certain that its result will be required; ie execute them
\r
1969 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
\r
1970 this is OK, because PrimOps are usually cheap, but it isn't OK for
\r
1971 (a)~expensive PrimOps and (b)~PrimOps which can fail.
\r
1973 See also @primOpIsCheap@ (below).
\r
1975 PrimOps that have side effects also should not be executed speculatively
\r
1976 or by data dependencies.
\r
1979 primOpOkForSpeculation :: PrimOp -> Bool
\r
1980 primOpOkForSpeculation op
\r
1981 = not (primOpCanFail op || primOpHasSideEffects op || primOpOutOfLine op)
\r
1984 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
\r
1985 WARNING), we just borrow some other predicates for a
\r
1986 what-should-be-good-enough test. "Cheap" means willing to call it more
\r
1987 than once. Evaluation order is unaffected.
\r
1990 primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
\r
1993 primOpIsDupable means that the use of the primop is small enough to
\r
1994 duplicate into different case branches. See CoreUtils.exprIsDupable.
\r
1997 primOpIsDupable (CCallOp _ _ _ _) = False
\r
1998 primOpIsDupable op = not (primOpOutOfLine op)
\r
2003 primOpCanFail :: PrimOp -> Bool
\r
2005 primOpCanFail IntQuotOp = True -- Divide by zero
\r
2006 primOpCanFail IntRemOp = True -- Divide by zero
\r
2009 primOpCanFail IntegerQuotRemOp = True -- Divide by zero
\r
2010 primOpCanFail IntegerDivModOp = True -- Divide by zero
\r
2012 -- Float. ToDo: tan? tanh?
\r
2013 primOpCanFail FloatDivOp = True -- Divide by zero
\r
2014 primOpCanFail FloatLogOp = True -- Log of zero
\r
2015 primOpCanFail FloatAsinOp = True -- Arg out of domain
\r
2016 primOpCanFail FloatAcosOp = True -- Arg out of domain
\r
2018 -- Double. ToDo: tan? tanh?
\r
2019 primOpCanFail DoubleDivOp = True -- Divide by zero
\r
2020 primOpCanFail DoubleLogOp = True -- Log of zero
\r
2021 primOpCanFail DoubleAsinOp = True -- Arg out of domain
\r
2022 primOpCanFail DoubleAcosOp = True -- Arg out of domain
\r
2024 primOpCanFail other_op = False
\r
2027 And some primops have side-effects and so, for example, must not be
\r
2031 primOpHasSideEffects :: PrimOp -> Bool
\r
2033 primOpHasSideEffects TakeMVarOp = True
\r
2034 primOpHasSideEffects DelayOp = True
\r
2035 primOpHasSideEffects WaitReadOp = True
\r
2036 primOpHasSideEffects WaitWriteOp = True
\r
2038 primOpHasSideEffects ParOp = True
\r
2039 primOpHasSideEffects ForkOp = True
\r
2040 primOpHasSideEffects KillThreadOp = True
\r
2041 primOpHasSideEffects YieldOp = True
\r
2042 primOpHasSideEffects SeqOp = True
\r
2044 primOpHasSideEffects MakeForeignObjOp = True
\r
2045 primOpHasSideEffects WriteForeignObjOp = True
\r
2046 primOpHasSideEffects MkWeakOp = True
\r
2047 primOpHasSideEffects DeRefWeakOp = True
\r
2048 primOpHasSideEffects FinalizeWeakOp = True
\r
2049 primOpHasSideEffects MakeStablePtrOp = True
\r
2050 primOpHasSideEffects MakeStableNameOp = True
\r
2051 primOpHasSideEffects EqStablePtrOp = True -- SOF
\r
2052 primOpHasSideEffects DeRefStablePtrOp = True -- ??? JSM & ADR
\r
2054 primOpHasSideEffects ParGlobalOp = True
\r
2055 primOpHasSideEffects ParLocalOp = True
\r
2056 primOpHasSideEffects ParAtOp = True
\r
2057 primOpHasSideEffects ParAtAbsOp = True
\r
2058 primOpHasSideEffects ParAtRelOp = True
\r
2059 primOpHasSideEffects ParAtForNowOp = True
\r
2060 primOpHasSideEffects CopyableOp = True -- Possibly not. ASP
\r
2061 primOpHasSideEffects NoFollowOp = True -- Possibly not. ASP
\r
2064 primOpHasSideEffects (CCallOp _ _ _ _) = True
\r
2066 primOpHasSideEffects other = False
\r
2069 Inline primitive operations that perform calls need wrappers to save
\r
2070 any live variables that are stored in caller-saves registers.
\r
2073 primOpNeedsWrapper :: PrimOp -> Bool
\r
2075 primOpNeedsWrapper (CCallOp _ _ _ _) = True
\r
2077 primOpNeedsWrapper Integer2IntOp = True
\r
2078 primOpNeedsWrapper Integer2WordOp = True
\r
2079 primOpNeedsWrapper IntegerCmpOp = True
\r
2080 primOpNeedsWrapper IntegerCmpIntOp = True
\r
2082 primOpNeedsWrapper FloatExpOp = True
\r
2083 primOpNeedsWrapper FloatLogOp = True
\r
2084 primOpNeedsWrapper FloatSqrtOp = True
\r
2085 primOpNeedsWrapper FloatSinOp = True
\r
2086 primOpNeedsWrapper FloatCosOp = True
\r
2087 primOpNeedsWrapper FloatTanOp = True
\r
2088 primOpNeedsWrapper FloatAsinOp = True
\r
2089 primOpNeedsWrapper FloatAcosOp = True
\r
2090 primOpNeedsWrapper FloatAtanOp = True
\r
2091 primOpNeedsWrapper FloatSinhOp = True
\r
2092 primOpNeedsWrapper FloatCoshOp = True
\r
2093 primOpNeedsWrapper FloatTanhOp = True
\r
2094 primOpNeedsWrapper FloatPowerOp = True
\r
2096 primOpNeedsWrapper DoubleExpOp = True
\r
2097 primOpNeedsWrapper DoubleLogOp = True
\r
2098 primOpNeedsWrapper DoubleSqrtOp = True
\r
2099 primOpNeedsWrapper DoubleSinOp = True
\r
2100 primOpNeedsWrapper DoubleCosOp = True
\r
2101 primOpNeedsWrapper DoubleTanOp = True
\r
2102 primOpNeedsWrapper DoubleAsinOp = True
\r
2103 primOpNeedsWrapper DoubleAcosOp = True
\r
2104 primOpNeedsWrapper DoubleAtanOp = True
\r
2105 primOpNeedsWrapper DoubleSinhOp = True
\r
2106 primOpNeedsWrapper DoubleCoshOp = True
\r
2107 primOpNeedsWrapper DoubleTanhOp = True
\r
2108 primOpNeedsWrapper DoublePowerOp = True
\r
2110 primOpNeedsWrapper MakeStableNameOp = True
\r
2111 primOpNeedsWrapper DeRefStablePtrOp = True
\r
2113 primOpNeedsWrapper DelayOp = True
\r
2114 primOpNeedsWrapper WaitReadOp = True
\r
2115 primOpNeedsWrapper WaitWriteOp = True
\r
2117 primOpNeedsWrapper other_op = False
\r
2121 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
\r
2123 = case (primOpInfo op) of
\r
2124 Dyadic occ ty -> dyadic_fun_ty ty
\r
2125 Monadic occ ty -> monadic_fun_ty ty
\r
2126 Compare occ ty -> compare_fun_ty ty
\r
2128 GenPrimOp occ tyvars arg_tys res_ty ->
\r
2129 mkForAllTys tyvars (mkFunTys arg_tys res_ty)
\r
2131 mkPrimOpIdName :: PrimOp -> Id -> Name
\r
2132 -- Make the name for the PrimOp's Id
\r
2133 -- We have to pass in the Id itself because it's a WiredInId
\r
2134 -- and hence recursive
\r
2135 mkPrimOpIdName op id
\r
2136 = mkWiredInIdName key pREL_GHC occ_name id
\r
2138 occ_name = primOpOcc op
\r
2139 key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
\r
2142 primOpRdrName :: PrimOp -> RdrName
\r
2143 primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
\r
2145 primOpOcc :: PrimOp -> OccName
\r
2146 primOpOcc op = case (primOpInfo op) of
\r
2147 Dyadic occ _ -> occ
\r
2148 Monadic occ _ -> occ
\r
2149 Compare occ _ -> occ
\r
2150 GenPrimOp occ _ _ _ -> occ
\r
2152 -- primOpSig is like primOpType but gives the result split apart:
\r
2153 -- (type variables, argument types, result type)
\r
2155 primOpSig :: PrimOp -> ([TyVar],[Type],Type)
\r
2157 = case (primOpInfo op) of
\r
2158 Monadic occ ty -> ([], [ty], ty )
\r
2159 Dyadic occ ty -> ([], [ty,ty], ty )
\r
2160 Compare occ ty -> ([], [ty,ty], boolTy)
\r
2161 GenPrimOp occ tyvars arg_tys res_ty
\r
2162 -> (tyvars, arg_tys, res_ty)
\r
2164 -- primOpUsg is like primOpSig but the types it yields are the
\r
2165 -- appropriate sigma (i.e., usage-annotated) types,
\r
2166 -- as required by the UsageSP inference.
\r
2168 primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
\r
2172 -- Refer to comment by `otherwise' clause; we need consider here
\r
2173 -- *only* primops that have arguments or results containing Haskell
\r
2174 -- pointers (things that are pointed). Unpointed values are
\r
2175 -- irrelevant to the usage analysis. The issue is whether pointed
\r
2176 -- values may be entered or duplicated by the primop.
\r
2178 -- Remember that primops are *never* partially applied.
\r
2180 NewArrayOp -> mangle [mkP, mkM, mkP ] mkM
\r
2181 SameMutableArrayOp -> mangle [mkP, mkP ] mkM
\r
2182 ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM
\r
2183 WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR
\r
2184 IndexArrayOp -> mangle [mkM, mkP ] mkM
\r
2185 UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM
\r
2186 UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM
\r
2188 NewMutVarOp -> mangle [mkM, mkP ] mkM
\r
2189 ReadMutVarOp -> mangle [mkM, mkP ] mkM
\r
2190 WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR
\r
2191 SameMutVarOp -> mangle [mkP, mkP ] mkM
\r
2193 CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO
\r
2194 mangle [mkM, mkM . (inFun mkM mkM)] mkM
\r
2195 -- might use caught action multiply
\r
2196 RaiseOp -> mangle [mkM ] mkM
\r
2198 NewMVarOp -> mangle [mkP ] mkR
\r
2199 TakeMVarOp -> mangle [mkM, mkP ] mkM
\r
2200 PutMVarOp -> mangle [mkM, mkM, mkP ] mkR
\r
2201 SameMVarOp -> mangle [mkP, mkP ] mkM
\r
2202 IsEmptyMVarOp -> mangle [mkP, mkP ] mkM
\r
2204 ForkOp -> mangle [mkO, mkP ] mkR
\r
2205 KillThreadOp -> mangle [mkP, mkM, mkP ] mkR
\r
2207 MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM
\r
2208 DeRefWeakOp -> mangle [mkM, mkP ] mkM
\r
2209 FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM]))
\r
2211 MakeStablePtrOp -> mangle [mkM, mkP ] mkM
\r
2212 DeRefStablePtrOp -> mangle [mkM, mkP ] mkM
\r
2213 EqStablePtrOp -> mangle [mkP, mkP ] mkR
\r
2214 MakeStableNameOp -> mangle [mkZ, mkP ] mkR
\r
2215 EqStableNameOp -> mangle [mkP, mkP ] mkR
\r
2216 StableNameToIntOp -> mangle [mkP ] mkR
\r
2218 ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR
\r
2220 SeqOp -> mangle [mkO ] mkR
\r
2221 ParOp -> mangle [mkO ] mkR
\r
2222 ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
\r
2223 ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
\r
2224 ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
\r
2225 ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
\r
2226 ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM
\r
2227 ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM
\r
2228 CopyableOp -> mangle [mkZ ] mkR
\r
2229 NoFollowOp -> mangle [mkZ ] mkR
\r
2231 CCallOp _ _ _ _ -> mangle [ ] mkM
\r
2233 -- Things with no Haskell pointers inside: in actuality, usages are
\r
2234 -- irrelevant here (hence it doesn't matter that some of these
\r
2235 -- apparently permit duplication; since such arguments are never
\r
2236 -- ENTERed anyway, the usage annotation they get is entirely irrelevant
\r
2237 -- except insofar as it propagates to infect other values that *are*
\r
2240 otherwise -> nomangle
\r
2242 where mkZ = mkUsgTy UsOnce -- pointed argument used zero
\r
2243 mkO = mkUsgTy UsOnce -- pointed argument used once
\r
2244 mkM = mkUsgTy UsMany -- pointed argument used multiply
\r
2245 mkP = mkUsgTy UsOnce -- unpointed argument
\r
2246 mkR = mkUsgTy UsMany -- unpointed result
\r
2248 (tyvars, arg_tys, res_ty)
\r
2251 nomangle = (tyvars, map mkP arg_tys, mkR res_ty)
\r
2253 mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
\r
2255 inFun f g ty = case splitFunTy_maybe ty of
\r
2256 Just (a,b) -> mkFunTy (f a) (g b)
\r
2257 Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
\r
2259 inUB fs ty = case splitTyConApp_maybe ty of
\r
2260 Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) )
\r
2261 mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg"
\r
2263 Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty)
\r
2267 data PrimOpResultInfo
\r
2268 = ReturnsPrim PrimRep
\r
2269 | ReturnsAlg TyCon
\r
2271 -- Some PrimOps need not return a manifest primitive or algebraic value
\r
2272 -- (i.e. they might return a polymorphic value). These PrimOps *must*
\r
2273 -- be out of line, or the code generator won't work.
\r
2275 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
\r
2276 getPrimOpResultInfo op
\r
2277 = case (primOpInfo op) of
\r
2278 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
\r
2279 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
\r
2280 Compare _ ty -> ReturnsAlg boolTyCon
\r
2281 GenPrimOp _ _ _ ty ->
\r
2282 let rep = typePrimRep ty in
\r
2284 PtrRep -> case splitAlgTyConApp_maybe ty of
\r
2285 Nothing -> panic "getPrimOpResultInfo"
\r
2286 Just (tc,_,_) -> ReturnsAlg tc
\r
2287 other -> ReturnsPrim other
\r
2289 isCompareOp :: PrimOp -> Bool
\r
2291 = case primOpInfo op of
\r
2292 Compare _ _ -> True
\r
2296 The commutable ops are those for which we will try to move constants
\r
2297 to the right hand side for strength reduction.
\r
2300 commutableOp :: PrimOp -> Bool
\r
2302 commutableOp CharEqOp = True
\r
2303 commutableOp CharNeOp = True
\r
2304 commutableOp IntAddOp = True
\r
2305 commutableOp IntMulOp = True
\r
2306 commutableOp AndOp = True
\r
2307 commutableOp OrOp = True
\r
2308 commutableOp XorOp = True
\r
2309 commutableOp IntEqOp = True
\r
2310 commutableOp IntNeOp = True
\r
2311 commutableOp IntegerAddOp = True
\r
2312 commutableOp IntegerMulOp = True
\r
2313 commutableOp IntegerGcdOp = True
\r
2314 commutableOp FloatAddOp = True
\r
2315 commutableOp FloatMulOp = True
\r
2316 commutableOp FloatEqOp = True
\r
2317 commutableOp FloatNeOp = True
\r
2318 commutableOp DoubleAddOp = True
\r
2319 commutableOp DoubleMulOp = True
\r
2320 commutableOp DoubleEqOp = True
\r
2321 commutableOp DoubleNeOp = True
\r
2322 commutableOp _ = False
\r
2327 mkPrimTyApp :: [TyVar] -> PrimRep -> ([TyVar], Type)
\r
2328 -- CharRep --> ([], Char#)
\r
2329 -- StablePtrRep --> ([a], StablePtr# a)
\r
2330 mkPrimTyApp tvs kind
\r
2331 = (forall_tvs, mkTyConApp tycon (mkTyVarTys forall_tvs))
\r
2333 tycon = primRepTyCon kind
\r
2334 forall_tvs = take (tyConArity tycon) tvs
\r
2336 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
\r
2337 monadic_fun_ty ty = mkFunTy ty ty
\r
2338 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
\r
2343 pprPrimOp :: PrimOp -> SDoc
\r
2345 pprPrimOp (CCallOp fun is_casm may_gc cconv)
\r
2347 callconv = text "{-" <> pprCallConv cconv <> text "-}"
\r
2350 | is_casm && may_gc = "casm_GC ``"
\r
2351 | is_casm = "casm ``"
\r
2352 | may_gc = "ccall_GC "
\r
2353 | otherwise = "ccall "
\r
2356 | is_casm = text "''"
\r
2357 | otherwise = empty
\r
2361 Right _ -> text "dyn_"
\r
2366 Right _ -> text "\"\""
\r
2367 Left fn -> ptext fn
\r
2370 hcat [ ifPprDebug callconv
\r
2371 , text "__", ppr_dyn
\r
2372 , text before , ppr_fun , after]
\r
2374 pprPrimOp other_op
\r
2375 = getPprStyle $ \ sty ->
\r
2376 if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
\r
2377 ptext SLIT("PrelGHC.") <> pprOccName occ
\r
2381 occ = primOpOcc other_op
\r