2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrimOp]{Primitive operations (machine-level)}
7 #include "HsVersions.h"
10 PrimOp(..), allThePrimOps,
11 tagOf_PrimOp, -- ToDo: rm
13 primOpType, isCompareOp,
19 primOpCanTriggerGC, primOpNeedsWrapper,
20 primOpOkForSpeculation, primOpIsCheap,
22 HeapRequirement(..), primOpHeapReq,
23 StackRequirement(..), primOpStackRequired,
25 -- export for the Native Code Generator
26 primOpInfo, -- needed for primOpNameInfo
34 import PrimRep -- most of it
38 import CStrings ( identToC )
39 import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
40 import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
41 import Outputable ( PprStyle, Outputable(..), codeStyle, ifaceStyle )
42 import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
44 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
45 import TyCon ( TyCon{-instances-} )
46 import Type ( mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep,
47 getAppDataTyConExpandingDicts, SYN_IE(Type)
49 import TyVar --( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
50 import Unique ( Unique{-instance Eq-} )
51 import Util ( panic#, assoc, panic{-ToDo:rm-} )
54 %************************************************************************
56 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
58 %************************************************************************
60 These are in \tr{state-interface.verb} order.
64 -- dig the FORTRAN/C influence on the names...
68 = CharGtOp | CharGeOp | CharEqOp | CharNeOp | CharLtOp | CharLeOp
69 | IntGtOp | IntGeOp | IntEqOp | IntNeOp | IntLtOp | IntLeOp
70 | WordGtOp | WordGeOp | WordEqOp | WordNeOp | WordLtOp | WordLeOp
71 | AddrGtOp | AddrGeOp | AddrEqOp | AddrNeOp | AddrLtOp | AddrLeOp
72 | FloatGtOp | FloatGeOp | FloatEqOp | FloatNeOp | FloatLtOp | FloatLeOp
73 | DoubleGtOp | DoubleGeOp | DoubleEqOp | DoubleNeOp | DoubleLtOp | DoubleLeOp
79 -- IntAbsOp unused?? ADR
80 | IntAddOp | IntSubOp | IntMulOp | IntQuotOp
81 | IntRemOp | IntNegOp | IntAbsOp
82 | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical}
85 | WordQuotOp | WordRemOp
86 | AndOp | OrOp | NotOp | XorOp
87 | SllOp | SraOp | SrlOp -- shift {left,right} {arithmetic,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 | Int2IntegerOp
127 | Addr2IntegerOp -- "Addr" is *always* a literal string
130 | FloatEncodeOp | FloatDecodeOp
131 | DoubleEncodeOp | DoubleDecodeOp
133 -- primitive ops for primitive arrays
136 | NewByteArrayOp PrimRep
139 | SameMutableByteArrayOp
141 | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs
143 | ReadByteArrayOp PrimRep
144 | WriteByteArrayOp PrimRep
145 | IndexByteArrayOp PrimRep
146 | IndexOffAddrOp PrimRep
147 -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
148 -- This is just a cheesy encoding of a bunch of ops.
149 -- Note that ForeignObjRep is not included -- the only way of
150 -- creating a ForeignObj is with a ccall or casm.
151 | IndexOffForeignObjOp PrimRep
153 | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp
155 | NewSynchVarOp -- for MVars and IVars
156 | TakeMVarOp | PutMVarOp
157 | ReadIVarOp | WriteIVarOp
159 | MakeForeignObjOp -- foreign objects (malloc pointers or any old URL)
160 | WriteForeignObjOp -- modifying foreign objects [obscuro factor: 200]
161 | MakeStablePtrOp | DeRefStablePtrOp
164 A special ``trap-door'' to use in making calls direct to C functions:
166 | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function
167 Bool -- True <=> really a "casm"
168 Bool -- True <=> might invoke Haskell GC
169 [Type] -- Unboxed argument; the state-token
170 -- argument will have been put *first*
171 Type -- Return type; one of the "StateAnd<blah>#" types
173 -- (... to be continued ... )
176 The ``type'' of @CCallOp foo [t1, ... tm] r@ is @t1 -> ... tm -> r@.
177 (See @primOpInfo@ for details.)
179 Note: that first arg and part of the result should be the system state
180 token (which we carry around to fool over-zealous optimisers) but
181 which isn't actually passed.
183 For example, we represent
185 ((ccall# foo [StablePtr# a, Int] Float) sp# i#) :: (Float, IoWorld)
191 (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False)
192 -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse
196 (AlgAlts [ ( FloatPrimAndIoWorld,
198 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
204 Nota Bene: there are some people who find the empty list of types in
205 the @Prim@ somewhat puzzling and would represent the above by
209 (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False)
210 -- :: /\ alpha1, alpha2 alpha3, alpha4.
211 -- alpha1 -> alpha2 -> alpha3 -> alpha4
212 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld]
215 (AlgAlts [ ( FloatPrimAndIoWorld,
217 Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#]
223 But, this is a completely different way of using @CCallOp@. The most
224 major changes required if we switch to this are in @primOpInfo@, and
225 the desugarer. The major difficulty is in moving the HeapRequirement
226 stuff somewhere appropriate. (The advantage is that we could simplify
227 @CCallOp@ and record just the number of arguments with corresponding
228 simplifications in reading pragma unfoldings, the simplifier,
229 instantiation (etc) of core expressions, ... . Maybe we should think
230 about using it this way?? ADR)
233 -- (... continued from above ... )
235 -- one to support "errorIO" (and, thereby, "error")
238 -- Operation to test two closure addresses for equality (yes really!)
239 -- BLAME ALASTAIR REID FOR THIS! THE REST OF US ARE INNOCENT!
240 | ReallyUnsafePtrEqualityOp
242 -- three for parallel stuff
247 -- three for concurrency
252 | ParGlobalOp -- named global par
253 | ParLocalOp -- named local par
254 | ParAtOp -- specifies destination of local par
255 | ParAtAbsOp -- specifies destination of local par (abs processor)
256 | ParAtRelOp -- specifies destination of local par (rel processor)
257 | ParAtForNowOp -- specifies initial destination of global par
258 | CopyableOp -- marks copyable code
259 | NoFollowOp -- marks non-followup expression
262 Deriving Ix is what we really want! ToDo
263 (Chk around before deleting...)
265 tagOf_PrimOp CharGtOp = (ILIT(1) :: FAST_INT)
266 tagOf_PrimOp CharGeOp = ILIT( 2)
267 tagOf_PrimOp CharEqOp = ILIT( 3)
268 tagOf_PrimOp CharNeOp = ILIT( 4)
269 tagOf_PrimOp CharLtOp = ILIT( 5)
270 tagOf_PrimOp CharLeOp = ILIT( 6)
271 tagOf_PrimOp IntGtOp = ILIT( 7)
272 tagOf_PrimOp IntGeOp = ILIT( 8)
273 tagOf_PrimOp IntEqOp = ILIT( 9)
274 tagOf_PrimOp IntNeOp = ILIT( 10)
275 tagOf_PrimOp IntLtOp = ILIT( 11)
276 tagOf_PrimOp IntLeOp = ILIT( 12)
277 tagOf_PrimOp WordGtOp = ILIT( 13)
278 tagOf_PrimOp WordGeOp = ILIT( 14)
279 tagOf_PrimOp WordEqOp = ILIT( 15)
280 tagOf_PrimOp WordNeOp = ILIT( 16)
281 tagOf_PrimOp WordLtOp = ILIT( 17)
282 tagOf_PrimOp WordLeOp = ILIT( 18)
283 tagOf_PrimOp AddrGtOp = ILIT( 19)
284 tagOf_PrimOp AddrGeOp = ILIT( 20)
285 tagOf_PrimOp AddrEqOp = ILIT( 21)
286 tagOf_PrimOp AddrNeOp = ILIT( 22)
287 tagOf_PrimOp AddrLtOp = ILIT( 23)
288 tagOf_PrimOp AddrLeOp = ILIT( 24)
289 tagOf_PrimOp FloatGtOp = ILIT( 25)
290 tagOf_PrimOp FloatGeOp = ILIT( 26)
291 tagOf_PrimOp FloatEqOp = ILIT( 27)
292 tagOf_PrimOp FloatNeOp = ILIT( 28)
293 tagOf_PrimOp FloatLtOp = ILIT( 29)
294 tagOf_PrimOp FloatLeOp = ILIT( 30)
295 tagOf_PrimOp DoubleGtOp = ILIT( 31)
296 tagOf_PrimOp DoubleGeOp = ILIT( 32)
297 tagOf_PrimOp DoubleEqOp = ILIT( 33)
298 tagOf_PrimOp DoubleNeOp = ILIT( 34)
299 tagOf_PrimOp DoubleLtOp = ILIT( 35)
300 tagOf_PrimOp DoubleLeOp = ILIT( 36)
301 tagOf_PrimOp OrdOp = ILIT( 37)
302 tagOf_PrimOp ChrOp = ILIT( 38)
303 tagOf_PrimOp IntAddOp = ILIT( 39)
304 tagOf_PrimOp IntSubOp = ILIT( 40)
305 tagOf_PrimOp IntMulOp = ILIT( 41)
306 tagOf_PrimOp IntQuotOp = ILIT( 42)
307 tagOf_PrimOp IntRemOp = ILIT( 44)
308 tagOf_PrimOp IntNegOp = ILIT( 45)
309 tagOf_PrimOp IntAbsOp = ILIT( 47)
310 tagOf_PrimOp WordQuotOp = ILIT( 48)
311 tagOf_PrimOp WordRemOp = ILIT( 49)
312 tagOf_PrimOp AndOp = ILIT( 50)
313 tagOf_PrimOp OrOp = ILIT( 51)
314 tagOf_PrimOp NotOp = ILIT( 52)
315 tagOf_PrimOp XorOp = ILIT( 53)
316 tagOf_PrimOp SllOp = ILIT( 54)
317 tagOf_PrimOp SraOp = ILIT( 55)
318 tagOf_PrimOp SrlOp = ILIT( 56)
319 tagOf_PrimOp ISllOp = ILIT( 57)
320 tagOf_PrimOp ISraOp = ILIT( 58)
321 tagOf_PrimOp ISrlOp = ILIT( 59)
322 tagOf_PrimOp Int2WordOp = ILIT( 60)
323 tagOf_PrimOp Word2IntOp = ILIT( 61)
324 tagOf_PrimOp Int2AddrOp = ILIT( 62)
325 tagOf_PrimOp Addr2IntOp = ILIT( 63)
326 tagOf_PrimOp FloatAddOp = ILIT( 64)
327 tagOf_PrimOp FloatSubOp = ILIT( 65)
328 tagOf_PrimOp FloatMulOp = ILIT( 66)
329 tagOf_PrimOp FloatDivOp = ILIT( 67)
330 tagOf_PrimOp FloatNegOp = ILIT( 68)
331 tagOf_PrimOp Float2IntOp = ILIT( 69)
332 tagOf_PrimOp Int2FloatOp = ILIT( 70)
333 tagOf_PrimOp FloatExpOp = ILIT( 71)
334 tagOf_PrimOp FloatLogOp = ILIT( 72)
335 tagOf_PrimOp FloatSqrtOp = ILIT( 73)
336 tagOf_PrimOp FloatSinOp = ILIT( 74)
337 tagOf_PrimOp FloatCosOp = ILIT( 75)
338 tagOf_PrimOp FloatTanOp = ILIT( 76)
339 tagOf_PrimOp FloatAsinOp = ILIT( 77)
340 tagOf_PrimOp FloatAcosOp = ILIT( 78)
341 tagOf_PrimOp FloatAtanOp = ILIT( 79)
342 tagOf_PrimOp FloatSinhOp = ILIT( 80)
343 tagOf_PrimOp FloatCoshOp = ILIT( 81)
344 tagOf_PrimOp FloatTanhOp = ILIT( 82)
345 tagOf_PrimOp FloatPowerOp = ILIT( 83)
346 tagOf_PrimOp DoubleAddOp = ILIT( 84)
347 tagOf_PrimOp DoubleSubOp = ILIT( 85)
348 tagOf_PrimOp DoubleMulOp = ILIT( 86)
349 tagOf_PrimOp DoubleDivOp = ILIT( 87)
350 tagOf_PrimOp DoubleNegOp = ILIT( 88)
351 tagOf_PrimOp Double2IntOp = ILIT( 89)
352 tagOf_PrimOp Int2DoubleOp = ILIT( 90)
353 tagOf_PrimOp Double2FloatOp = ILIT( 91)
354 tagOf_PrimOp Float2DoubleOp = ILIT( 92)
355 tagOf_PrimOp DoubleExpOp = ILIT( 93)
356 tagOf_PrimOp DoubleLogOp = ILIT( 94)
357 tagOf_PrimOp DoubleSqrtOp = ILIT( 95)
358 tagOf_PrimOp DoubleSinOp = ILIT( 96)
359 tagOf_PrimOp DoubleCosOp = ILIT( 97)
360 tagOf_PrimOp DoubleTanOp = ILIT( 98)
361 tagOf_PrimOp DoubleAsinOp = ILIT( 99)
362 tagOf_PrimOp DoubleAcosOp = ILIT(100)
363 tagOf_PrimOp DoubleAtanOp = ILIT(101)
364 tagOf_PrimOp DoubleSinhOp = ILIT(102)
365 tagOf_PrimOp DoubleCoshOp = ILIT(103)
366 tagOf_PrimOp DoubleTanhOp = ILIT(104)
367 tagOf_PrimOp DoublePowerOp = ILIT(105)
368 tagOf_PrimOp IntegerAddOp = ILIT(106)
369 tagOf_PrimOp IntegerSubOp = ILIT(107)
370 tagOf_PrimOp IntegerMulOp = ILIT(108)
371 tagOf_PrimOp IntegerQuotRemOp = ILIT(109)
372 tagOf_PrimOp IntegerDivModOp = ILIT(110)
373 tagOf_PrimOp IntegerNegOp = ILIT(111)
374 tagOf_PrimOp IntegerCmpOp = ILIT(112)
375 tagOf_PrimOp Integer2IntOp = ILIT(113)
376 tagOf_PrimOp Int2IntegerOp = ILIT(114)
377 tagOf_PrimOp Word2IntegerOp = ILIT(115)
378 tagOf_PrimOp Addr2IntegerOp = ILIT(116)
379 tagOf_PrimOp FloatEncodeOp = ILIT(117)
380 tagOf_PrimOp FloatDecodeOp = ILIT(118)
381 tagOf_PrimOp DoubleEncodeOp = ILIT(119)
382 tagOf_PrimOp DoubleDecodeOp = ILIT(120)
383 tagOf_PrimOp NewArrayOp = ILIT(121)
384 tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(122)
385 tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(123)
386 tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(124)
387 tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(125)
388 tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(126)
389 tagOf_PrimOp SameMutableArrayOp = ILIT(127)
390 tagOf_PrimOp SameMutableByteArrayOp = ILIT(128)
391 tagOf_PrimOp ReadArrayOp = ILIT(129)
392 tagOf_PrimOp WriteArrayOp = ILIT(130)
393 tagOf_PrimOp IndexArrayOp = ILIT(131)
394 tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(132)
395 tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(133)
396 tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(134)
397 tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(135)
398 tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(136)
399 tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(137)
400 tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(138)
401 tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(139)
402 tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(140)
403 tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(141)
404 tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(142)
405 tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(143)
406 tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(144)
407 tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(145)
408 tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(146)
409 tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(147)
410 tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(148)
411 tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(149)
412 tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(150)
413 tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(151)
414 tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(152)
415 tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(153)
416 tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(154)
417 tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(155)
418 tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(156)
419 tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(157)
420 tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(158)
421 tagOf_PrimOp NewSynchVarOp = ILIT(159)
422 tagOf_PrimOp TakeMVarOp = ILIT(160)
423 tagOf_PrimOp PutMVarOp = ILIT(161)
424 tagOf_PrimOp ReadIVarOp = ILIT(162)
425 tagOf_PrimOp WriteIVarOp = ILIT(163)
426 tagOf_PrimOp MakeForeignObjOp = ILIT(164)
427 tagOf_PrimOp WriteForeignObjOp = ILIT(165)
428 tagOf_PrimOp MakeStablePtrOp = ILIT(166)
429 tagOf_PrimOp DeRefStablePtrOp = ILIT(167)
430 tagOf_PrimOp (CCallOp _ _ _ _ _) = ILIT(168)
431 tagOf_PrimOp ErrorIOPrimOp = ILIT(169)
432 tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(170)
433 tagOf_PrimOp SeqOp = ILIT(171)
434 tagOf_PrimOp ParOp = ILIT(172)
435 tagOf_PrimOp ForkOp = ILIT(173)
436 tagOf_PrimOp DelayOp = ILIT(174)
437 tagOf_PrimOp WaitReadOp = ILIT(175)
438 tagOf_PrimOp WaitWriteOp = ILIT(176)
439 tagOf_PrimOp ParGlobalOp = ILIT(177)
440 tagOf_PrimOp ParLocalOp = ILIT(178)
441 tagOf_PrimOp ParAtOp = ILIT(179)
442 tagOf_PrimOp ParAtAbsOp = ILIT(180)
443 tagOf_PrimOp ParAtRelOp = ILIT(181)
444 tagOf_PrimOp ParAtForNowOp = ILIT(182)
445 tagOf_PrimOp CopyableOp = ILIT(183)
446 tagOf_PrimOp NoFollowOp = ILIT(184)
448 tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match"
450 instance Eq PrimOp where
451 op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2
454 An @Enum@-derived list would be better; meanwhile... (ToDo)
575 NewByteArrayOp CharRep,
576 NewByteArrayOp IntRep,
577 NewByteArrayOp AddrRep,
578 NewByteArrayOp FloatRep,
579 NewByteArrayOp DoubleRep,
581 SameMutableByteArrayOp,
585 ReadByteArrayOp CharRep,
586 ReadByteArrayOp IntRep,
587 ReadByteArrayOp AddrRep,
588 ReadByteArrayOp FloatRep,
589 ReadByteArrayOp DoubleRep,
590 WriteByteArrayOp CharRep,
591 WriteByteArrayOp IntRep,
592 WriteByteArrayOp AddrRep,
593 WriteByteArrayOp FloatRep,
594 WriteByteArrayOp DoubleRep,
595 IndexByteArrayOp CharRep,
596 IndexByteArrayOp IntRep,
597 IndexByteArrayOp AddrRep,
598 IndexByteArrayOp FloatRep,
599 IndexByteArrayOp DoubleRep,
600 IndexOffAddrOp CharRep,
601 IndexOffAddrOp IntRep,
602 IndexOffAddrOp AddrRep,
603 IndexOffAddrOp FloatRep,
604 IndexOffAddrOp DoubleRep,
605 IndexOffForeignObjOp CharRep,
606 IndexOffForeignObjOp IntRep,
607 IndexOffForeignObjOp AddrRep,
608 IndexOffForeignObjOp FloatRep,
609 IndexOffForeignObjOp DoubleRep,
611 UnsafeFreezeByteArrayOp,
622 ReallyUnsafePtrEqualityOp,
641 %************************************************************************
643 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
645 %************************************************************************
647 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
648 refer to the primitive operation. The conventional \tr{#}-for-
649 unboxed ops is added on later.
651 The reason for the funny characters in the names is so we do not
652 interfere with the programmer's Haskell name spaces.
654 We use @PrimKinds@ for the ``type'' information, because they're
655 (slightly) more convenient to use than @TyCons@.
658 = Dyadic FAST_STRING -- string :: T -> T -> T
660 | Monadic FAST_STRING -- string :: T -> T
662 | Compare FAST_STRING -- string :: T -> T -> Bool
664 | Coercing FAST_STRING -- string :: T1 -> T2
668 | PrimResult FAST_STRING
669 [TyVar] [Type] TyCon PrimRep [Type]
670 -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]"
671 -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm)
672 -- D# is a primitive type constructor.
673 -- (the kind is the same info as D#, in another convenient form)
675 | AlgResult FAST_STRING
676 [TyVar] [Type] TyCon [Type]
677 -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]"
678 -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm)
680 -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable
685 one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy]
687 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces
688 intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces
689 an_Integer_and_Int_tys
690 = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer
693 integerMonadic name = AlgResult name [] one_Integer_ty integerTyCon []
695 integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon []
697 integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon []
699 integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep []
702 @primOpInfo@ gives all essential information (from which everything
703 else, notably a type, can be constructed) for each @PrimOp@.
706 primOpInfo :: PrimOp -> PrimOpInfo
709 There's plenty of this stuff!
711 %************************************************************************
713 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
715 %************************************************************************
718 primOpInfo CharGtOp = Compare SLIT("gtChar#") charPrimTy
719 primOpInfo CharGeOp = Compare SLIT("geChar#") charPrimTy
720 primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy
721 primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy
722 primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy
723 primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy
725 primOpInfo IntGtOp = Compare SLIT(">#") intPrimTy
726 primOpInfo IntGeOp = Compare SLIT(">=#") intPrimTy
727 primOpInfo IntEqOp = Compare SLIT("==#") intPrimTy
728 primOpInfo IntNeOp = Compare SLIT("/=#") intPrimTy
729 primOpInfo IntLtOp = Compare SLIT("<#") intPrimTy
730 primOpInfo IntLeOp = Compare SLIT("<=#") intPrimTy
732 primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy
733 primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy
734 primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy
735 primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy
736 primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy
737 primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy
739 primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy
740 primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy
741 primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy
742 primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy
743 primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy
744 primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy
746 primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy
747 primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy
748 primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy
749 primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy
750 primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy
751 primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy
753 primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
754 primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
755 primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
756 primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
757 primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
758 primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
761 %************************************************************************
763 \subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s}
765 %************************************************************************
768 primOpInfo OrdOp = Coercing SLIT("ord#") charPrimTy intPrimTy
769 primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
772 %************************************************************************
774 \subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s}
776 %************************************************************************
779 primOpInfo IntAddOp = Dyadic SLIT("+#") intPrimTy
780 primOpInfo IntSubOp = Dyadic SLIT("-#") intPrimTy
781 primOpInfo IntMulOp = Dyadic SLIT("*#") intPrimTy
782 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy
783 primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy
785 primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy
786 primOpInfo IntAbsOp = Monadic SLIT("absInt#") intPrimTy
789 %************************************************************************
791 \subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s}
793 %************************************************************************
795 A @Word#@ is an unsigned @Int#@.
798 primOpInfo WordQuotOp = Dyadic SLIT("quotWord#") wordPrimTy
799 primOpInfo WordRemOp = Dyadic SLIT("remWord#") wordPrimTy
801 primOpInfo AndOp = Dyadic SLIT("and#") wordPrimTy
802 primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy
803 primOpInfo XorOp = Dyadic SLIT("xor#") wordPrimTy
804 primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy
807 = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
809 = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
811 = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep []
814 = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
816 = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
818 = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep []
820 primOpInfo Int2WordOp = Coercing SLIT("int2Word#") intPrimTy wordPrimTy
821 primOpInfo Word2IntOp = Coercing SLIT("word2Int#") wordPrimTy intPrimTy
824 %************************************************************************
826 \subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s}
828 %************************************************************************
831 primOpInfo Int2AddrOp = Coercing SLIT("int2Addr#") intPrimTy addrPrimTy
832 primOpInfo Addr2IntOp = Coercing SLIT("addr2Int#") addrPrimTy intPrimTy
835 %************************************************************************
837 \subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s}
839 %************************************************************************
841 @encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's
845 primOpInfo FloatAddOp = Dyadic SLIT("plusFloat#") floatPrimTy
846 primOpInfo FloatSubOp = Dyadic SLIT("minusFloat#") floatPrimTy
847 primOpInfo FloatMulOp = Dyadic SLIT("timesFloat#") floatPrimTy
848 primOpInfo FloatDivOp = Dyadic SLIT("divideFloat#") floatPrimTy
849 primOpInfo FloatNegOp = Monadic SLIT("negateFloat#") floatPrimTy
851 primOpInfo Float2IntOp = Coercing SLIT("float2Int#") floatPrimTy intPrimTy
852 primOpInfo Int2FloatOp = Coercing SLIT("int2Float#") intPrimTy floatPrimTy
854 primOpInfo FloatExpOp = Monadic SLIT("expFloat#") floatPrimTy
855 primOpInfo FloatLogOp = Monadic SLIT("logFloat#") floatPrimTy
856 primOpInfo FloatSqrtOp = Monadic SLIT("sqrtFloat#") floatPrimTy
857 primOpInfo FloatSinOp = Monadic SLIT("sinFloat#") floatPrimTy
858 primOpInfo FloatCosOp = Monadic SLIT("cosFloat#") floatPrimTy
859 primOpInfo FloatTanOp = Monadic SLIT("tanFloat#") floatPrimTy
860 primOpInfo FloatAsinOp = Monadic SLIT("asinFloat#") floatPrimTy
861 primOpInfo FloatAcosOp = Monadic SLIT("acosFloat#") floatPrimTy
862 primOpInfo FloatAtanOp = Monadic SLIT("atanFloat#") floatPrimTy
863 primOpInfo FloatSinhOp = Monadic SLIT("sinhFloat#") floatPrimTy
864 primOpInfo FloatCoshOp = Monadic SLIT("coshFloat#") floatPrimTy
865 primOpInfo FloatTanhOp = Monadic SLIT("tanhFloat#") floatPrimTy
866 primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy
869 %************************************************************************
871 \subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s}
873 %************************************************************************
875 @encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's
879 primOpInfo DoubleAddOp = Dyadic SLIT("+##") doublePrimTy
880 primOpInfo DoubleSubOp = Dyadic SLIT("-##") doublePrimTy
881 primOpInfo DoubleMulOp = Dyadic SLIT("*##") doublePrimTy
882 primOpInfo DoubleDivOp = Dyadic SLIT("/##") doublePrimTy
883 primOpInfo DoubleNegOp = Monadic SLIT("negateDouble#") doublePrimTy
885 primOpInfo Double2IntOp = Coercing SLIT("double2Int#") doublePrimTy intPrimTy
886 primOpInfo Int2DoubleOp = Coercing SLIT("int2Double#") intPrimTy doublePrimTy
888 primOpInfo Double2FloatOp = Coercing SLIT("double2Float#") doublePrimTy floatPrimTy
889 primOpInfo Float2DoubleOp = Coercing SLIT("float2Double#") floatPrimTy doublePrimTy
891 primOpInfo DoubleExpOp = Monadic SLIT("expDouble#") doublePrimTy
892 primOpInfo DoubleLogOp = Monadic SLIT("logDouble#") doublePrimTy
893 primOpInfo DoubleSqrtOp = Monadic SLIT("sqrtDouble#") doublePrimTy
894 primOpInfo DoubleSinOp = Monadic SLIT("sinDouble#") doublePrimTy
895 primOpInfo DoubleCosOp = Monadic SLIT("cosDouble#") doublePrimTy
896 primOpInfo DoubleTanOp = Monadic SLIT("tanDouble#") doublePrimTy
897 primOpInfo DoubleAsinOp = Monadic SLIT("asinDouble#") doublePrimTy
898 primOpInfo DoubleAcosOp = Monadic SLIT("acosDouble#") doublePrimTy
899 primOpInfo DoubleAtanOp = Monadic SLIT("atanDouble#") doublePrimTy
900 primOpInfo DoubleSinhOp = Monadic SLIT("sinhDouble#") doublePrimTy
901 primOpInfo DoubleCoshOp = Monadic SLIT("coshDouble#") doublePrimTy
902 primOpInfo DoubleTanhOp = Monadic SLIT("tanhDouble#") doublePrimTy
903 primOpInfo DoublePowerOp= Dyadic SLIT("**##") doublePrimTy
906 %************************************************************************
908 \subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)}
910 %************************************************************************
913 primOpInfo IntegerNegOp = integerMonadic SLIT("negateInteger#")
915 primOpInfo IntegerAddOp = integerDyadic SLIT("plusInteger#")
916 primOpInfo IntegerSubOp = integerDyadic SLIT("minusInteger#")
917 primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#")
919 primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#")
921 primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#")
922 primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#")
924 primOpInfo Integer2IntOp
925 = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep []
927 primOpInfo Int2IntegerOp
928 = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon []
930 primOpInfo Word2IntegerOp
931 = AlgResult SLIT("word2Integer#") [] [wordPrimTy] integerTyCon []
933 primOpInfo Addr2IntegerOp
934 = AlgResult SLIT("addr2Integer#") [] [addrPrimTy] integerTyCon []
937 Encoding and decoding of floating-point numbers is sorta
941 primOpInfo FloatEncodeOp
942 = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys
943 floatPrimTyCon FloatRep []
945 primOpInfo DoubleEncodeOp
946 = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys
947 doublePrimTyCon DoubleRep []
949 primOpInfo FloatDecodeOp
950 = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon []
952 primOpInfo DoubleDecodeOp
953 = AlgResult SLIT("decodeDouble#") [] [doublePrimTy] returnIntAndGMPTyCon []
956 %************************************************************************
958 \subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays}
960 %************************************************************************
963 primOpInfo NewArrayOp
965 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
967 AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s]
968 stateAndMutableArrayPrimTyCon [s, elt]
970 primOpInfo (NewByteArrayOp kind)
972 s = alphaTy; s_tv = alphaTyVar
974 (str, _, prim_tycon) = getPrimRepInfo kind
976 op_str = _PK_ ("new" ++ str ++ "Array#")
978 AlgResult op_str [s_tv]
979 [intPrimTy, mkStatePrimTy s]
980 stateAndMutableByteArrayPrimTyCon [s]
982 ---------------------------------------------------------------------------
984 primOpInfo SameMutableArrayOp
986 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar;
987 mut_arr_ty = mkMutableArrayPrimTy s elt
989 AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty]
992 primOpInfo SameMutableByteArrayOp
994 s = alphaTy; s_tv = alphaTyVar;
995 mut_arr_ty = mkMutableByteArrayPrimTy s
997 AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty]
1000 ---------------------------------------------------------------------------
1001 -- Primitive arrays of Haskell pointers:
1003 primOpInfo ReadArrayOp
1005 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1007 AlgResult SLIT("readArray#") [s_tv, elt_tv]
1008 [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s]
1009 stateAndPtrPrimTyCon [s, elt]
1012 primOpInfo WriteArrayOp
1014 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1016 PrimResult SLIT("writeArray#") [s_tv, elt_tv]
1017 [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s]
1018 statePrimTyCon VoidRep [s]
1020 primOpInfo IndexArrayOp
1021 = let { elt = alphaTy; elt_tv = alphaTyVar } in
1022 AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy]
1025 ---------------------------------------------------------------------------
1026 -- Primitive arrays full of unboxed bytes:
1028 primOpInfo (ReadByteArrayOp kind)
1030 s = alphaTy; s_tv = alphaTyVar
1032 (str, _, prim_tycon) = getPrimRepInfo kind
1034 op_str = _PK_ ("read" ++ str ++ "Array#")
1035 relevant_tycon = assoc "primOpInfo" tbl kind
1037 AlgResult op_str [s_tv]
1038 [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s]
1041 tbl = [ (CharRep, stateAndCharPrimTyCon),
1042 (IntRep, stateAndIntPrimTyCon),
1043 (AddrRep, stateAndAddrPrimTyCon),
1044 (FloatRep, stateAndFloatPrimTyCon),
1045 (DoubleRep, stateAndDoublePrimTyCon) ]
1047 -- How come there's no Word byte arrays? ADR
1049 primOpInfo (WriteByteArrayOp kind)
1051 s = alphaTy; s_tv = alphaTyVar
1053 (str, prim_ty, _) = getPrimRepInfo kind
1054 op_str = _PK_ ("write" ++ str ++ "Array#")
1056 -- NB: *Prim*Result --
1057 PrimResult op_str [s_tv]
1058 [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s]
1059 statePrimTyCon VoidRep [s]
1061 primOpInfo (IndexByteArrayOp kind)
1063 (str, _, prim_tycon) = getPrimRepInfo kind
1064 op_str = _PK_ ("index" ++ str ++ "Array#")
1066 -- NB: *Prim*Result --
1067 PrimResult op_str [] [byteArrayPrimTy, intPrimTy] prim_tycon kind []
1069 primOpInfo (IndexOffAddrOp kind)
1071 (str, _, prim_tycon) = getPrimRepInfo kind
1072 op_str = _PK_ ("index" ++ str ++ "OffAddr#")
1074 PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind []
1076 primOpInfo (IndexOffForeignObjOp kind)
1078 (str, _, prim_tycon) = getPrimRepInfo kind
1079 op_str = _PK_ ("index" ++ str ++ "OffForeignObj#")
1081 PrimResult op_str [] [foreignObjPrimTy, intPrimTy] prim_tycon kind []
1083 ---------------------------------------------------------------------------
1084 primOpInfo UnsafeFreezeArrayOp
1086 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1088 AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv]
1089 [mkMutableArrayPrimTy s elt, mkStatePrimTy s]
1090 stateAndArrayPrimTyCon [s, elt]
1092 primOpInfo UnsafeFreezeByteArrayOp
1093 = let { s = alphaTy; s_tv = alphaTyVar } in
1094 AlgResult SLIT("unsafeFreezeByteArray#") [s_tv]
1095 [mkMutableByteArrayPrimTy s, mkStatePrimTy s]
1096 stateAndByteArrayPrimTyCon [s]
1099 %************************************************************************
1101 \subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables}
1103 %************************************************************************
1106 primOpInfo NewSynchVarOp
1108 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1110 AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s]
1111 stateAndSynchVarPrimTyCon [s, elt]
1113 primOpInfo TakeMVarOp
1115 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1117 AlgResult SLIT("takeMVar#") [s_tv, elt_tv]
1118 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1119 stateAndPtrPrimTyCon [s, elt]
1121 primOpInfo PutMVarOp
1123 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1125 AlgResult SLIT("putMVar#") [s_tv, elt_tv]
1126 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1129 primOpInfo ReadIVarOp
1131 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1133 AlgResult SLIT("readIVar#") [s_tv, elt_tv]
1134 [mkSynchVarPrimTy s elt, mkStatePrimTy s]
1135 stateAndPtrPrimTyCon [s, elt]
1137 primOpInfo WriteIVarOp
1139 elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar
1141 AlgResult SLIT("writeIVar#") [s_tv, elt_tv]
1142 [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s]
1147 %************************************************************************
1149 \subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations}
1151 %************************************************************************
1157 s = alphaTy; s_tv = alphaTyVar
1159 PrimResult SLIT("delay#") [s_tv]
1160 [intPrimTy, mkStatePrimTy s]
1161 statePrimTyCon VoidRep [s]
1163 primOpInfo WaitReadOp
1165 s = alphaTy; s_tv = alphaTyVar
1167 PrimResult SLIT("waitRead#") [s_tv]
1168 [intPrimTy, mkStatePrimTy s]
1169 statePrimTyCon VoidRep [s]
1171 primOpInfo WaitWriteOp
1173 s = alphaTy; s_tv = alphaTyVar
1175 PrimResult SLIT("waitWrite#") [s_tv]
1176 [intPrimTy, mkStatePrimTy s]
1177 statePrimTyCon VoidRep [s]
1180 %************************************************************************
1182 \subsubsection[PrimOps-ForeignObj]{PrimOpInfo for Foreign Objects}
1184 %************************************************************************
1186 Not everything should/can be in the Haskell heap. As an example, in an
1187 image processing application written in Haskell, you really would like
1188 to avoid heaving huge images between different space or generations of
1189 a garbage collector. Instead use @ForeignObj@ (formerly known as @MallocPtr@),
1190 which refer to some externally allocated structure/value. Using @ForeignObj@,
1191 just a reference to an image is present in the heap, the image could then
1192 be stored outside the Haskell heap, i.e., as a malloc'ed structure or in
1193 a completely separate address space alltogether.
1195 When a @ForeignObj@ becomes garbage, a user-defined finalisation routine
1196 associated with the object is invoked (currently, each ForeignObj has a
1197 direct reference to its finaliser). -- SOF
1199 A @ForeignObj@ is created by the @makeForeignObj#@ primitive:
1202 makeForeignObj# :: Addr# -- foreign object
1203 -> Addr# -- ptr to its finaliser routine
1204 -> StateAndForeignObj# _RealWorld# ForeignObj#
1209 primOpInfo MakeForeignObjOp
1210 = AlgResult SLIT("makeForeignObj#") []
1211 [addrPrimTy, addrPrimTy, realWorldStatePrimTy]
1212 stateAndForeignObjPrimTyCon [realWorldTy]
1216 In addition, another @ForeignObj@ primitive is provided for destructively modifying
1217 the external object wrapped up inside a @ForeignObj@. This primitive is used
1218 when a mixed programming interface of implicit and explicit de-allocation is used,
1219 e.g., if @ForeignObj@s are used to implement @Handle@s, then @Handle@s can be
1220 released either explicitly (through @hClose@) or implicitly (via a finaliser).
1221 When releasing/closing the @Handle@ explicitly, care must be taken to avoid having
1222 the finaliser for the embedded @ForeignObj@ attempt the same thing later.
1223 We deal with this situation, by allowing the programmer to destructively modify
1224 the data field of the @ForeignObj@ to hold a special value the finaliser recognises,
1225 and does not attempt to free (e.g., filling the data slot with \tr{NULL}).
1228 writeForeignObj# :: ForeignObj# -- foreign object
1229 -> Addr# -- new data value
1230 -> StateAndForeignObj# _RealWorld# ForeignObj#
1234 primOpInfo WriteForeignObjOp
1236 s = alphaTy; s_tv = alphaTyVar
1238 PrimResult SLIT("writeForeignObj#") [s_tv]
1239 [foreignObjPrimTy, addrPrimTy, mkStatePrimTy s]
1240 statePrimTyCon VoidRep [s]
1243 %************************************************************************
1245 \subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''}
1247 %************************************************************************
1249 A {\em stable pointer} is an index into a table of pointers into the
1250 heap. Since the garbage collector is told about stable pointers, it
1251 is safe to pass a stable pointer to external systems such as C
1254 Here's what the operations and types are supposed to be (from
1255 state-interface document).
1258 makeStablePtr# :: a -> State# _RealWorld -> StateAndStablePtr# _RealWorld a
1259 freeStablePtr# :: StablePtr# a -> State# _RealWorld -> State# _RealWorld
1260 deRefStablePtr# :: StablePtr# a -> State# _RealWorld -> StateAndPtr _RealWorld a
1263 It may seem a bit surprising that @makeStablePtr#@ is a @PrimIO@
1264 operation since it doesn't (directly) involve IO operations. The
1265 reason is that if some optimisation pass decided to duplicate calls to
1266 @makeStablePtr#@ and we only pass one of the stable pointers over, a
1267 massive space leak can result. Putting it into the PrimIO monad
1268 prevents this. (Another reason for putting them in a monad is to
1269 ensure correct sequencing wrt the side-effecting @freeStablePtr#@
1272 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
1273 besides, it's not likely to be used from Haskell) so it's not a
1276 Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
1279 primOpInfo MakeStablePtrOp
1280 = AlgResult SLIT("makeStablePtr#") [alphaTyVar]
1281 [alphaTy, realWorldStatePrimTy]
1282 stateAndStablePtrPrimTyCon [realWorldTy, alphaTy]
1284 primOpInfo DeRefStablePtrOp
1285 = AlgResult SLIT("deRefStablePtr#") [alphaTyVar]
1286 [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy]
1287 stateAndPtrPrimTyCon [realWorldTy, alphaTy]
1290 %************************************************************************
1292 \subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality}
1294 %************************************************************************
1296 [Alastair Reid is to blame for this!]
1298 These days, (Glasgow) Haskell seems to have a bit of everything from
1299 other languages: strict operations, mutable variables, sequencing,
1300 pointers, etc. About the only thing left is LISP's ability to test
1301 for pointer equality. So, let's add it in!
1304 reallyUnsafePtrEquality :: a -> a -> Int#
1307 which tests any two closures (of the same type) to see if they're the
1308 same. (Returns $0$ for @False@, $\neq 0$ for @True@ - to avoid
1309 difficulties of trying to box up the result.)
1311 NB This is {\em really unsafe\/} because even something as trivial as
1312 a garbage collection might change the answer by removing indirections.
1313 Still, no-one's forcing you to use it. If you're worried about little
1314 things like loss of referential transparency, you might like to wrap
1315 it all up in a monad-like thing as John O'Donnell and John Hughes did
1316 for non-determinism (1989 (Fraserburgh) Glasgow FP Workshop
1319 I'm thinking of using it to speed up a critical equality test in some
1320 graphics stuff in a context where the possibility of saying that
1321 denotationally equal things aren't isn't a problem (as long as it
1322 doesn't happen too often.) ADR
1324 To Will: Jim said this was already in, but I can't see it so I'm
1325 adding it. Up to you whether you add it. (Note that this could have
1326 been readily implemented using a @veryDangerousCCall@ before they were
1330 primOpInfo ReallyUnsafePtrEqualityOp
1331 = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar]
1332 [alphaTy, alphaTy] intPrimTyCon IntRep []
1335 %************************************************************************
1337 \subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)}
1339 %************************************************************************
1342 primOpInfo SeqOp -- seq# :: a -> Int#
1343 = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1345 primOpInfo ParOp -- par# :: a -> Int#
1346 = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1348 primOpInfo ForkOp -- fork# :: a -> Int#
1349 = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep []
1354 -- HWL: The first 4 Int# in all par... annotations denote:
1355 -- name, granularity info, size of result, degree of parallelism
1356 -- Same structure as _seq_ i.e. returns Int#
1358 primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1359 = PrimResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1361 primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b
1362 = PrimResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1364 primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1365 = PrimResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1367 primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1368 = PrimResult SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1370 primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b
1371 = PrimResult SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTyCon IntRep [] -- liftTyCon [betaTy]
1373 primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c
1374 = PrimResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTyCon IntRep [] -- liftTyCon [gammaTy]
1376 primOpInfo CopyableOp -- copyable# :: a -> a
1377 = PrimResult SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1379 primOpInfo NoFollowOp -- noFollow# :: a -> a
1380 = PrimResult SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] -- liftTyCon [alphaTy]
1383 %************************************************************************
1385 \subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@}
1387 %************************************************************************
1390 -- errorIO# :: (State# RealWorld# -> a) -> State# RealWorld#
1391 primOpInfo ErrorIOPrimOp
1392 = PrimResult SLIT("errorIO#") [alphaTyVar]
1393 [mkFunTy realWorldStatePrimTy alphaTy]
1394 statePrimTyCon VoidRep [realWorldTy]
1397 %************************************************************************
1399 \subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things}
1401 %************************************************************************
1404 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
1405 = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
1407 (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
1410 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
1414 %************************************************************************
1416 \subsection[PrimOp-utils]{Utilities for @PrimitiveOps@}
1418 %************************************************************************
1420 The primitive-array-creation @PrimOps@ and {\em most} of those to do
1421 with @Integers@ can trigger GC. Here we describe the heap requirements
1422 of the various @PrimOps@. For most, no heap is required. For a few,
1423 a fixed amount of heap is required, and the needs of the @PrimOp@ can
1424 be combined with the rest of the heap usage in the basic block. For an
1425 unfortunate few, some unknown amount of heap is required (these are the
1426 ops which can trigger GC).
1429 data HeapRequirement
1431 | FixedHeapRequired HeapOffset
1432 | VariableHeapRequired
1434 primOpHeapReq :: PrimOp -> HeapRequirement
1436 primOpHeapReq NewArrayOp = VariableHeapRequired
1437 primOpHeapReq (NewByteArrayOp _)= VariableHeapRequired
1439 primOpHeapReq IntegerAddOp = VariableHeapRequired
1440 primOpHeapReq IntegerSubOp = VariableHeapRequired
1441 primOpHeapReq IntegerMulOp = VariableHeapRequired
1442 primOpHeapReq IntegerQuotRemOp = VariableHeapRequired
1443 primOpHeapReq IntegerDivModOp = VariableHeapRequired
1444 primOpHeapReq IntegerNegOp = VariableHeapRequired
1445 primOpHeapReq Int2IntegerOp = FixedHeapRequired
1446 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1447 (intOff mIN_MP_INT_SIZE))
1448 primOpHeapReq Word2IntegerOp = FixedHeapRequired
1449 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1450 (intOff mIN_MP_INT_SIZE))
1451 primOpHeapReq Addr2IntegerOp = VariableHeapRequired
1452 primOpHeapReq FloatDecodeOp = FixedHeapRequired
1453 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1454 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1455 (intOff mIN_MP_INT_SIZE)))
1456 primOpHeapReq DoubleDecodeOp = FixedHeapRequired
1457 (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE))
1458 (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE))
1459 (intOff mIN_MP_INT_SIZE)))
1462 ccall may allocate heap if it is explicitly allowed to (_ccall_gc_)
1463 or if it returns a ForeignObj.
1465 Hmm..the allocation for makeForeignObj# is known (and fixed), so
1466 why dod we need to be so indeterminate about it? --SOF
1468 primOpHeapReq (CCallOp _ _ mayGC@True _ _) = VariableHeapRequired
1469 primOpHeapReq (CCallOp _ _ mayGC@False _ _) = NoHeapRequired
1471 primOpHeapReq MakeForeignObjOp = VariableHeapRequired
1472 primOpHeapReq WriteForeignObjOp = NoHeapRequired
1474 -- this occasionally has to expand the Stable Pointer table
1475 primOpHeapReq MakeStablePtrOp = VariableHeapRequired
1477 -- These four only need heap space with the native code generator
1478 -- ToDo!: parameterize, so we know if native code generation is taking place(JSM)
1480 primOpHeapReq IntegerCmpOp = FixedHeapRequired (intOff (2 * mP_STRUCT_SIZE))
1481 primOpHeapReq Integer2IntOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1482 primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1483 primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE)
1485 -- a NewSynchVarOp creates a three-word mutuple in the heap.
1486 primOpHeapReq NewSynchVarOp = FixedHeapRequired
1487 (addOff (totHdrSize (MuTupleRep 3)) (intOff 3))
1489 -- Sparking ops no longer allocate any heap; however, _fork_ may
1490 -- require a context switch to clear space in the required thread
1491 -- pool, and that requires liveness information.
1493 primOpHeapReq ParOp = NoHeapRequired
1494 primOpHeapReq ForkOp = VariableHeapRequired
1496 -- A SeqOp requires unknown space to evaluate its argument
1497 primOpHeapReq SeqOp = VariableHeapRequired
1499 -- GranSim sparks are stgMalloced i.e. no heap required
1500 primOpHeapReq ParGlobalOp = NoHeapRequired
1501 primOpHeapReq ParLocalOp = NoHeapRequired
1502 primOpHeapReq ParAtOp = NoHeapRequired
1503 primOpHeapReq ParAtAbsOp = NoHeapRequired
1504 primOpHeapReq ParAtRelOp = NoHeapRequired
1505 primOpHeapReq ParAtForNowOp = NoHeapRequired
1506 -- CopyableOp and NoFolowOp don't require heap; don't rely on default
1507 primOpHeapReq CopyableOp = NoHeapRequired
1508 primOpHeapReq NoFollowOp = NoHeapRequired
1510 primOpHeapReq other_op = NoHeapRequired
1513 The amount of stack required by primops.
1516 data StackRequirement
1518 | FixedStackRequired Int {-AStack-} Int {-BStack-}
1519 | VariableStackRequired
1521 primOpStackRequired SeqOp = FixedStackRequired 0 {-AStack-} 2 {-BStack-}
1522 primOpStackRequired _ = VariableStackRequired
1523 -- ToDo: be more specific for certain primops (currently only used for seq)
1526 Primops which can trigger GC have to be called carefully.
1527 In particular, their arguments are guaranteed to be in registers,
1528 and a liveness mask tells which regs are live.
1531 primOpCanTriggerGC op
1539 case primOpHeapReq op of
1540 VariableHeapRequired -> True
1544 Sometimes we may choose to execute a PrimOp even though it isn't
1545 certain that its result will be required; ie execute them
1546 ``speculatively''. The same thing as ``cheap eagerness.'' Usually
1547 this is OK, because PrimOps are usually cheap, but it isn't OK for
1548 (a)~expensive PrimOps and (b)~PrimOps which can fail.
1550 See also @primOpIsCheap@ (below).
1552 There should be no worries about side effects; that's all taken care
1553 of by data dependencies.
1556 primOpOkForSpeculation :: PrimOp -> Bool
1559 primOpOkForSpeculation IntQuotOp = False -- Divide by zero
1560 primOpOkForSpeculation IntRemOp = False -- Divide by zero
1563 primOpOkForSpeculation IntegerQuotRemOp = False -- Divide by zero
1564 primOpOkForSpeculation IntegerDivModOp = False -- Divide by zero
1566 -- Float. ToDo: tan? tanh?
1567 primOpOkForSpeculation FloatDivOp = False -- Divide by zero
1568 primOpOkForSpeculation FloatLogOp = False -- Log of zero
1569 primOpOkForSpeculation FloatAsinOp = False -- Arg out of domain
1570 primOpOkForSpeculation FloatAcosOp = False -- Arg out of domain
1572 -- Double. ToDo: tan? tanh?
1573 primOpOkForSpeculation DoubleDivOp = False -- Divide by zero
1574 primOpOkForSpeculation DoubleLogOp = False -- Log of zero
1575 primOpOkForSpeculation DoubleAsinOp = False -- Arg out of domain
1576 primOpOkForSpeculation DoubleAcosOp = False -- Arg out of domain
1579 primOpOkForSpeculation (CCallOp _ _ _ _ _)= False -- Could be expensive!
1582 primOpOkForSpeculation ErrorIOPrimOp = False -- Could be disastrous!
1585 primOpOkForSpeculation ParOp = False -- Could be expensive!
1586 primOpOkForSpeculation ForkOp = False -- Likewise
1587 primOpOkForSpeculation SeqOp = False -- Likewise
1589 primOpOkForSpeculation ParGlobalOp = False -- Could be expensive!
1590 primOpOkForSpeculation ParLocalOp = False -- Could be expensive!
1591 primOpOkForSpeculation ParAtOp = False -- Could be expensive!
1592 primOpOkForSpeculation ParAtAbsOp = False -- Could be expensive!
1593 primOpOkForSpeculation ParAtRelOp = False -- Could be expensive!
1594 primOpOkForSpeculation ParAtForNowOp = False -- Could be expensive!
1595 primOpOkForSpeculation CopyableOp = False -- only tags closure
1596 primOpOkForSpeculation NoFollowOp = False -- only tags closure
1598 -- The default is "yes it's ok for speculation"
1599 primOpOkForSpeculation other_op = True
1602 @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK
1603 WARNING), we just borrow some other predicates for a
1604 what-should-be-good-enough test.
1607 = primOpOkForSpeculation op && not (primOpCanTriggerGC op)
1610 And some primops have side-effects and so, for example, must not be
1614 fragilePrimOp :: PrimOp -> Bool
1616 fragilePrimOp ParOp = True
1617 fragilePrimOp ForkOp = True
1618 fragilePrimOp SeqOp = True
1619 fragilePrimOp MakeForeignObjOp = True -- SOF
1620 fragilePrimOp WriteForeignObjOp = True -- SOF
1621 fragilePrimOp MakeStablePtrOp = True
1622 fragilePrimOp DeRefStablePtrOp = True -- ??? JSM & ADR
1624 fragilePrimOp ParGlobalOp = True
1625 fragilePrimOp ParLocalOp = True
1626 fragilePrimOp ParAtOp = True
1627 fragilePrimOp ParAtAbsOp = True
1628 fragilePrimOp ParAtRelOp = True
1629 fragilePrimOp ParAtForNowOp = True
1630 fragilePrimOp CopyableOp = True -- Possibly not. ASP
1631 fragilePrimOp NoFollowOp = True -- Possibly not. ASP
1633 fragilePrimOp other = False
1636 Primitive operations that perform calls need wrappers to save any live variables
1637 that are stored in caller-saves registers
1640 primOpNeedsWrapper :: PrimOp -> Bool
1642 primOpNeedsWrapper (CCallOp _ _ _ _ _) = True
1644 primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM)
1645 primOpNeedsWrapper (NewByteArrayOp _) = True
1647 primOpNeedsWrapper IntegerAddOp = True
1648 primOpNeedsWrapper IntegerSubOp = True
1649 primOpNeedsWrapper IntegerMulOp = True
1650 primOpNeedsWrapper IntegerQuotRemOp = True
1651 primOpNeedsWrapper IntegerDivModOp = True
1652 primOpNeedsWrapper IntegerNegOp = True
1653 primOpNeedsWrapper IntegerCmpOp = True
1654 primOpNeedsWrapper Integer2IntOp = True
1655 primOpNeedsWrapper Int2IntegerOp = True
1656 primOpNeedsWrapper Word2IntegerOp = True
1657 primOpNeedsWrapper Addr2IntegerOp = True
1659 primOpNeedsWrapper FloatExpOp = True
1660 primOpNeedsWrapper FloatLogOp = True
1661 primOpNeedsWrapper FloatSqrtOp = True
1662 primOpNeedsWrapper FloatSinOp = True
1663 primOpNeedsWrapper FloatCosOp = True
1664 primOpNeedsWrapper FloatTanOp = True
1665 primOpNeedsWrapper FloatAsinOp = True
1666 primOpNeedsWrapper FloatAcosOp = True
1667 primOpNeedsWrapper FloatAtanOp = True
1668 primOpNeedsWrapper FloatSinhOp = True
1669 primOpNeedsWrapper FloatCoshOp = True
1670 primOpNeedsWrapper FloatTanhOp = True
1671 primOpNeedsWrapper FloatPowerOp = True
1672 primOpNeedsWrapper FloatEncodeOp = True
1673 primOpNeedsWrapper FloatDecodeOp = True
1675 primOpNeedsWrapper DoubleExpOp = True
1676 primOpNeedsWrapper DoubleLogOp = True
1677 primOpNeedsWrapper DoubleSqrtOp = True
1678 primOpNeedsWrapper DoubleSinOp = True
1679 primOpNeedsWrapper DoubleCosOp = True
1680 primOpNeedsWrapper DoubleTanOp = True
1681 primOpNeedsWrapper DoubleAsinOp = True
1682 primOpNeedsWrapper DoubleAcosOp = True
1683 primOpNeedsWrapper DoubleAtanOp = True
1684 primOpNeedsWrapper DoubleSinhOp = True
1685 primOpNeedsWrapper DoubleCoshOp = True
1686 primOpNeedsWrapper DoubleTanhOp = True
1687 primOpNeedsWrapper DoublePowerOp = True
1688 primOpNeedsWrapper DoubleEncodeOp = True
1689 primOpNeedsWrapper DoubleDecodeOp = True
1691 primOpNeedsWrapper MakeForeignObjOp = True
1692 primOpNeedsWrapper WriteForeignObjOp = True
1693 primOpNeedsWrapper MakeStablePtrOp = True
1694 primOpNeedsWrapper DeRefStablePtrOp = True
1696 primOpNeedsWrapper TakeMVarOp = True
1697 primOpNeedsWrapper PutMVarOp = True
1698 primOpNeedsWrapper ReadIVarOp = True
1700 primOpNeedsWrapper DelayOp = True
1701 primOpNeedsWrapper WaitReadOp = True
1702 primOpNeedsWrapper WaitWriteOp = True
1704 primOpNeedsWrapper other_op = False
1709 = case (primOpInfo op) of
1711 Monadic str _ -> str
1712 Compare str _ -> str
1713 Coercing str _ _ -> str
1714 PrimResult str _ _ _ _ _ -> str
1715 AlgResult str _ _ _ _ -> str
1718 @primOpType@ duplicates some work of @primOpId@, but since we
1719 grab types pretty often...
1721 primOpType :: PrimOp -> Type
1724 = case (primOpInfo op) of
1725 Dyadic str ty -> dyadic_fun_ty ty
1726 Monadic str ty -> monadic_fun_ty ty
1727 Compare str ty -> compare_fun_ty ty
1728 Coercing str ty1 ty2 -> mkFunTy ty1 ty2
1730 PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
1731 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
1733 AlgResult str tyvars arg_tys tycon res_tys ->
1734 mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
1738 data PrimOpResultInfo
1739 = ReturnsPrim PrimRep
1742 -- ToDo: Deal with specialised PrimOps
1743 -- Will need to return specialised tycon and data constructors
1745 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
1747 getPrimOpResultInfo op
1748 = case (primOpInfo op) of
1749 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
1750 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
1751 Compare _ ty -> ReturnsAlg boolTyCon
1752 Coercing _ _ ty -> ReturnsPrim (typePrimRep ty)
1753 PrimResult _ _ _ _ kind _ -> ReturnsPrim kind
1754 AlgResult _ _ _ tycon _ -> ReturnsAlg tycon
1756 isCompareOp :: PrimOp -> Bool
1759 = case primOpInfo op of
1764 The commutable ops are those for which we will try to move constants
1765 to the right hand side for strength reduction.
1768 commutableOp :: PrimOp -> Bool
1770 commutableOp CharEqOp = True
1771 commutableOp CharNeOp = True
1772 commutableOp IntAddOp = True
1773 commutableOp IntMulOp = True
1774 commutableOp AndOp = True
1775 commutableOp OrOp = True
1776 commutableOp XorOp = True
1777 commutableOp IntEqOp = True
1778 commutableOp IntNeOp = True
1779 commutableOp IntegerAddOp = True
1780 commutableOp IntegerMulOp = True
1781 commutableOp FloatAddOp = True
1782 commutableOp FloatMulOp = True
1783 commutableOp FloatEqOp = True
1784 commutableOp FloatNeOp = True
1785 commutableOp DoubleAddOp = True
1786 commutableOp DoubleMulOp = True
1787 commutableOp DoubleEqOp = True
1788 commutableOp DoubleNeOp = True
1789 commutableOp _ = False
1794 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
1795 monadic_fun_ty ty = mkFunTy ty ty
1796 compare_fun_ty ty = mkFunTys [ty, ty] boolTy
1801 pprPrimOp :: PprStyle -> PrimOp -> Doc
1802 showPrimOp :: PprStyle -> PrimOp -> String
1804 showPrimOp sty op = render (pprPrimOp sty op)
1806 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
1810 if may_gc then "_casm_GC_ ``" else "_casm_ ``"
1812 if may_gc then "_ccall_GC_ " else "_ccall_ "
1815 = if is_casm then text "''" else empty
1818 = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
1820 hcat [text before, ptext fun, after, space, brackets pp_tys]
1822 pprPrimOp sty other_op
1823 | codeStyle sty -- For C just print the primop itself
1826 | ifaceStyle sty -- For interfaces Print it qualified with GHC.
1827 = ptext SLIT("GHC.") <> ptext str
1829 | otherwise -- Unqualified is good enough
1832 str = primOp_str other_op
1836 instance Outputable PrimOp where
1837 ppr sty op = pprPrimOp sty op