Implement unboxed sum primitive type
[ghc.git] / compiler / prelude / PrimOp.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[PrimOp]{Primitive operations (machine-level)}
5 -}
6
7 {-# LANGUAGE CPP #-}
8
9 -- The default is a bit too low for the quite large primOpInfo definition
10 #if __GLASGOW_HASKELL__ >= 801
11 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}
12 #endif
13
14 module PrimOp (
15 PrimOp(..), PrimOpVecCat(..), allThePrimOps,
16 primOpType, primOpSig,
17 primOpTag, maxPrimOpTag, primOpOcc,
18
19 tagToEnumKey,
20
21 primOpOutOfLine, primOpCodeSize,
22 primOpOkForSpeculation, primOpOkForSideEffects,
23 primOpIsCheap, primOpFixity,
24
25 getPrimOpResultInfo, PrimOpResultInfo(..),
26
27 PrimCall(..)
28 ) where
29
30 #include "HsVersions.h"
31
32 import TysPrim
33 import TysWiredIn
34
35 import CmmType
36 import Demand
37 import OccName ( OccName, pprOccName, mkVarOccFS )
38 import TyCon ( TyCon, isPrimTyCon, PrimRep(..) )
39 import Type
40 import RepType ( typePrimRep, tyConPrimRep )
41 import BasicTypes ( Arity, Fixity(..), FixityDirection(..), Boxity(..) )
42 import ForeignCall ( CLabelString )
43 import Unique ( Unique, mkPrimOpIdUnique )
44 import Outputable
45 import FastString
46 import Module ( UnitId )
47
48 {-
49 ************************************************************************
50 * *
51 \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
52 * *
53 ************************************************************************
54
55 These are in \tr{state-interface.verb} order.
56 -}
57
58 -- supplies:
59 -- data PrimOp = ...
60 #include "primop-data-decl.hs-incl"
61
62 -- supplies
63 -- primOpTag :: PrimOp -> Int
64 #include "primop-tag.hs-incl"
65 primOpTag _ = error "primOpTag: unknown primop"
66
67
68 instance Eq PrimOp where
69 op1 == op2 = primOpTag op1 == primOpTag op2
70
71 instance Ord PrimOp where
72 op1 < op2 = primOpTag op1 < primOpTag op2
73 op1 <= op2 = primOpTag op1 <= primOpTag op2
74 op1 >= op2 = primOpTag op1 >= primOpTag op2
75 op1 > op2 = primOpTag op1 > primOpTag op2
76 op1 `compare` op2 | op1 < op2 = LT
77 | op1 == op2 = EQ
78 | otherwise = GT
79
80 instance Outputable PrimOp where
81 ppr op = pprPrimOp op
82
83 data PrimOpVecCat = IntVec
84 | WordVec
85 | FloatVec
86
87 -- An @Enum@-derived list would be better; meanwhile... (ToDo)
88
89 allThePrimOps :: [PrimOp]
90 allThePrimOps =
91 #include "primop-list.hs-incl"
92
93 tagToEnumKey :: Unique
94 tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)
95
96 {-
97 ************************************************************************
98 * *
99 \subsection[PrimOp-info]{The essential info about each @PrimOp@}
100 * *
101 ************************************************************************
102
103 The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
104 refer to the primitive operation. The conventional \tr{#}-for-
105 unboxed ops is added on later.
106
107 The reason for the funny characters in the names is so we do not
108 interfere with the programmer's Haskell name spaces.
109
110 We use @PrimKinds@ for the ``type'' information, because they're
111 (slightly) more convenient to use than @TyCons@.
112 -}
113
114 data PrimOpInfo
115 = Dyadic OccName -- string :: T -> T -> T
116 Type
117 | Monadic OccName -- string :: T -> T
118 Type
119 | Compare OccName -- string :: T -> T -> Int#
120 Type
121 | GenPrimOp OccName -- string :: \/a1..an . T1 -> .. -> Tk -> T
122 [TyVar]
123 [Type]
124 Type
125
126 mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo
127 mkDyadic str ty = Dyadic (mkVarOccFS str) ty
128 mkMonadic str ty = Monadic (mkVarOccFS str) ty
129 mkCompare str ty = Compare (mkVarOccFS str) ty
130
131 mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo
132 mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
133
134 {-
135 ************************************************************************
136 * *
137 \subsubsection{Strictness}
138 * *
139 ************************************************************************
140
141 Not all primops are strict!
142 -}
143
144 primOpStrictness :: PrimOp -> Arity -> StrictSig
145 -- See Demand.StrictnessInfo for discussion of what the results
146 -- The arity should be the arity of the primop; that's why
147 -- this function isn't exported.
148 #include "primop-strictness.hs-incl"
149
150 {-
151 ************************************************************************
152 * *
153 \subsubsection{Fixity}
154 * *
155 ************************************************************************
156 -}
157
158 primOpFixity :: PrimOp -> Maybe Fixity
159 #include "primop-fixity.hs-incl"
160
161 {-
162 ************************************************************************
163 * *
164 \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
165 * *
166 ************************************************************************
167
168 @primOpInfo@ gives all essential information (from which everything
169 else, notably a type, can be constructed) for each @PrimOp@.
170 -}
171
172 primOpInfo :: PrimOp -> PrimOpInfo
173 #include "primop-primop-info.hs-incl"
174 primOpInfo _ = error "primOpInfo: unknown primop"
175
176 {-
177 Here are a load of comments from the old primOp info:
178
179 A @Word#@ is an unsigned @Int#@.
180
181 @decodeFloat#@ is given w/ Integer-stuff (it's similar).
182
183 @decodeDouble#@ is given w/ Integer-stuff (it's similar).
184
185 Decoding of floating-point numbers is sorta Integer-related. Encoding
186 is done with plain ccalls now (see PrelNumExtra.hs).
187
188 A @Weak@ Pointer is created by the @mkWeak#@ primitive:
189
190 mkWeak# :: k -> v -> f -> State# RealWorld
191 -> (# State# RealWorld, Weak# v #)
192
193 In practice, you'll use the higher-level
194
195 data Weak v = Weak# v
196 mkWeak :: k -> v -> IO () -> IO (Weak v)
197
198 The following operation dereferences a weak pointer. The weak pointer
199 may have been finalized, so the operation returns a result code which
200 must be inspected before looking at the dereferenced value.
201
202 deRefWeak# :: Weak# v -> State# RealWorld ->
203 (# State# RealWorld, v, Int# #)
204
205 Only look at v if the Int# returned is /= 0 !!
206
207 The higher-level op is
208
209 deRefWeak :: Weak v -> IO (Maybe v)
210
211 Weak pointers can be finalized early by using the finalize# operation:
212
213 finalizeWeak# :: Weak# v -> State# RealWorld ->
214 (# State# RealWorld, Int#, IO () #)
215
216 The Int# returned is either
217
218 0 if the weak pointer has already been finalized, or it has no
219 finalizer (the third component is then invalid).
220
221 1 if the weak pointer is still alive, with the finalizer returned
222 as the third component.
223
224 A {\em stable name/pointer} is an index into a table of stable name
225 entries. Since the garbage collector is told about stable pointers,
226 it is safe to pass a stable pointer to external systems such as C
227 routines.
228
229 \begin{verbatim}
230 makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
231 freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld
232 deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
233 eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int#
234 \end{verbatim}
235
236 It may seem a bit surprising that @makeStablePtr#@ is a @IO@
237 operation since it doesn't (directly) involve IO operations. The
238 reason is that if some optimisation pass decided to duplicate calls to
239 @makeStablePtr#@ and we only pass one of the stable pointers over, a
240 massive space leak can result. Putting it into the IO monad
241 prevents this. (Another reason for putting them in a monad is to
242 ensure correct sequencing wrt the side-effecting @freeStablePtr@
243 operation.)
244
245 An important property of stable pointers is that if you call
246 makeStablePtr# twice on the same object you get the same stable
247 pointer back.
248
249 Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
250 besides, it's not likely to be used from Haskell) so it's not a
251 primop.
252
253 Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
254
255 Stable Names
256 ~~~~~~~~~~~~
257
258 A stable name is like a stable pointer, but with three important differences:
259
260 (a) You can't deRef one to get back to the original object.
261 (b) You can convert one to an Int.
262 (c) You don't need to 'freeStableName'
263
264 The existence of a stable name doesn't guarantee to keep the object it
265 points to alive (unlike a stable pointer), hence (a).
266
267 Invariants:
268
269 (a) makeStableName always returns the same value for a given
270 object (same as stable pointers).
271
272 (b) if two stable names are equal, it implies that the objects
273 from which they were created were the same.
274
275 (c) stableNameToInt always returns the same Int for a given
276 stable name.
277
278
279 These primops are pretty weird.
280
281 dataToTag# :: a -> Int (arg must be an evaluated data type)
282 tagToEnum# :: Int -> a (result type must be an enumerated type)
283
284 The constraints aren't currently checked by the front end, but the
285 code generator will fall over if they aren't satisfied.
286
287 ************************************************************************
288 * *
289 Which PrimOps are out-of-line
290 * *
291 ************************************************************************
292
293 Some PrimOps need to be called out-of-line because they either need to
294 perform a heap check or they block.
295 -}
296
297 primOpOutOfLine :: PrimOp -> Bool
298 #include "primop-out-of-line.hs-incl"
299
300 {-
301 ************************************************************************
302 * *
303 Failure and side effects
304 * *
305 ************************************************************************
306
307 Note [PrimOp can_fail and has_side_effects]
308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
309 Both can_fail and has_side_effects mean that the primop has
310 some effect that is not captured entirely by its result value.
311
312 ---------- has_side_effects ---------------------
313 A primop "has_side_effects" if it has some *write* effect, visible
314 elsewhere
315 - writing to the world (I/O)
316 - writing to a mutable data structure (writeIORef)
317 - throwing a synchronous Haskell exception
318
319 Often such primops have a type like
320 State -> input -> (State, output)
321 so the state token guarantees ordering. In general we rely *only* on
322 data dependencies of the state token to enforce write-effect ordering
323
324 * NB1: if you inline unsafePerformIO, you may end up with
325 side-effecting ops whose 'state' output is discarded.
326 And programmers may do that by hand; see Trac #9390.
327 That is why we (conservatively) do not discard write-effecting
328 primops even if both their state and result is discarded.
329
330 * NB2: We consider primops, such as raiseIO#, that can raise a
331 (Haskell) synchronous exception to "have_side_effects" but not
332 "can_fail". We must be careful about not discarding such things;
333 see the paper "A semantics for imprecise exceptions".
334
335 * NB3: *Read* effects (like reading an IORef) don't count here,
336 because it doesn't matter if we don't do them, or do them more than
337 once. *Sequencing* is maintained by the data dependency of the state
338 token.
339
340 ---------- can_fail ----------------------------
341 A primop "can_fail" if it can fail with an *unchecked* exception on
342 some elements of its input domain. Main examples:
343 division (fails on zero demoninator)
344 array indexing (fails if the index is out of bounds)
345
346 An "unchecked exception" is one that is an outright error, (not
347 turned into a Haskell exception,) such as seg-fault or
348 divide-by-zero error. Such can_fail primops are ALWAYS surrounded
349 with a test that checks for the bad cases, but we need to be
350 very careful about code motion that might move it out of
351 the scope of the test.
352
353 Note [Transformations affected by can_fail and has_side_effects]
354 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
355 The can_fail and has_side_effects properties have the following effect
356 on program transformations. Summary table is followed by details.
357
358 can_fail has_side_effects
359 Discard NO NO
360 Float in YES YES
361 Float out NO NO
362 Duplicate YES NO
363
364 * Discarding. case (a `op` b) of _ -> rhs ===> rhs
365 You should not discard a has_side_effects primop; e.g.
366 case (writeIntArray# a i v s of (# _, _ #) -> True
367 Arguably you should be able to discard this, since the
368 returned stat token is not used, but that relies on NEVER
369 inlining unsafePerformIO, and programmers sometimes write
370 this kind of stuff by hand (Trac #9390). So we (conservatively)
371 never discard a has_side_effects primop.
372
373 However, it's fine to discard a can_fail primop. For example
374 case (indexIntArray# a i) of _ -> True
375 We can discard indexIntArray#; it has can_fail, but not
376 has_side_effects; see Trac #5658 which was all about this.
377 Notice that indexIntArray# is (in a more general handling of
378 effects) read effect, but we don't care about that here, and
379 treat read effects as *not* has_side_effects.
380
381 Similarly (a `/#` b) can be discarded. It can seg-fault or
382 cause a hardware exception, but not a synchronous Haskell
383 exception.
384
385
386
387 Synchronous Haskell exceptions, e.g. from raiseIO#, are treated
388 as has_side_effects and hence are not discarded.
389
390 * Float in. You can float a can_fail or has_side_effects primop
391 *inwards*, but not inside a lambda (see Duplication below).
392
393 * Float out. You must not float a can_fail primop *outwards* lest
394 you escape the dynamic scope of the test. Example:
395 case d ># 0# of
396 True -> case x /# d of r -> r +# 1
397 False -> 0
398 Here we must not float the case outwards to give
399 case x/# d of r ->
400 case d ># 0# of
401 True -> r +# 1
402 False -> 0
403
404 Nor can you float out a has_side_effects primop. For example:
405 if blah then case writeMutVar# v True s0 of (# s1 #) -> s1
406 else s0
407 Notice that s0 is mentioned in both branches of the 'if', but
408 only one of these two will actually be consumed. But if we
409 float out to
410 case writeMutVar# v True s0 of (# s1 #) ->
411 if blah then s1 else s0
412 the writeMutVar will be performed in both branches, which is
413 utterly wrong.
414
415 * Duplication. You cannot duplicate a has_side_effect primop. You
416 might wonder how this can occur given the state token threading, but
417 just look at Control.Monad.ST.Lazy.Imp.strictToLazy! We get
418 something like this
419 p = case readMutVar# s v of
420 (# s', r #) -> (S# s', r)
421 s' = case p of (s', r) -> s'
422 r = case p of (s', r) -> r
423
424 (All these bindings are boxed.) If we inline p at its two call
425 sites, we get a catastrophe: because the read is performed once when
426 s' is demanded, and once when 'r' is demanded, which may be much
427 later. Utterly wrong. Trac #3207 is real example of this happening.
428
429 However, it's fine to duplicate a can_fail primop. That is really
430 the only difference between can_fail and has_side_effects.
431
432 Note [Implementation: how can_fail/has_side_effects affect transformations]
433 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
434 How do we ensure that that floating/duplication/discarding are done right
435 in the simplifier?
436
437 Two main predicates on primpops test these flags:
438 primOpOkForSideEffects <=> not has_side_effects
439 primOpOkForSpeculation <=> not (has_side_effects || can_fail)
440
441 * The "no-float-out" thing is achieved by ensuring that we never
442 let-bind a can_fail or has_side_effects primop. The RHS of a
443 let-binding (which can float in and out freely) satisfies
444 exprOkForSpeculation; this is the let/app invariant. And
445 exprOkForSpeculation is false of can_fail and has_side_effects.
446
447 * So can_fail and has_side_effects primops will appear only as the
448 scrutinees of cases, and that's why the FloatIn pass is capable
449 of floating case bindings inwards.
450
451 * The no-duplicate thing is done via primOpIsCheap, by making
452 has_side_effects things (very very very) not-cheap!
453 -}
454
455 primOpHasSideEffects :: PrimOp -> Bool
456 #include "primop-has-side-effects.hs-incl"
457
458 primOpCanFail :: PrimOp -> Bool
459 #include "primop-can-fail.hs-incl"
460
461 primOpOkForSpeculation :: PrimOp -> Bool
462 -- See Note [PrimOp can_fail and has_side_effects]
463 -- See comments with CoreUtils.exprOkForSpeculation
464 -- primOpOkForSpeculation => primOpOkForSideEffects
465 primOpOkForSpeculation op
466 = primOpOkForSideEffects op
467 && not (primOpOutOfLine op || primOpCanFail op)
468 -- I think the "out of line" test is because out of line things can
469 -- be expensive (eg sine, cosine), and so we may not want to speculate them
470
471 primOpOkForSideEffects :: PrimOp -> Bool
472 primOpOkForSideEffects op
473 = not (primOpHasSideEffects op)
474
475 {-
476 Note [primOpIsCheap]
477 ~~~~~~~~~~~~~~~~~~~~
478 @primOpIsCheap@, as used in \tr{SimplUtils.hs}. For now (HACK
479 WARNING), we just borrow some other predicates for a
480 what-should-be-good-enough test. "Cheap" means willing to call it more
481 than once, and/or push it inside a lambda. The latter could change the
482 behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
483 -}
484
485 primOpIsCheap :: PrimOp -> Bool
486 -- See Note [PrimOp can_fail and has_side_effects]
487 primOpIsCheap op = primOpOkForSpeculation op
488 -- In March 2001, we changed this to
489 -- primOpIsCheap op = False
490 -- thereby making *no* primops seem cheap. But this killed eta
491 -- expansion on case (x ==# y) of True -> \s -> ...
492 -- which is bad. In particular a loop like
493 -- doLoop n = loop 0
494 -- where
495 -- loop i | i == n = return ()
496 -- | otherwise = bar i >> loop (i+1)
497 -- allocated a closure every time round because it doesn't eta expand.
498 --
499 -- The problem that originally gave rise to the change was
500 -- let x = a +# b *# c in x +# x
501 -- were we don't want to inline x. But primopIsCheap doesn't control
502 -- that (it's exprIsDupable that does) so the problem doesn't occur
503 -- even if primOpIsCheap sometimes says 'True'.
504
505 {-
506 ************************************************************************
507 * *
508 PrimOp code size
509 * *
510 ************************************************************************
511
512 primOpCodeSize
513 ~~~~~~~~~~~~~~
514 Gives an indication of the code size of a primop, for the purposes of
515 calculating unfolding sizes; see CoreUnfold.sizeExpr.
516 -}
517
518 primOpCodeSize :: PrimOp -> Int
519 #include "primop-code-size.hs-incl"
520
521 primOpCodeSizeDefault :: Int
522 primOpCodeSizeDefault = 1
523 -- CoreUnfold.primOpSize already takes into account primOpOutOfLine
524 -- and adds some further costs for the args in that case.
525
526 primOpCodeSizeForeignCall :: Int
527 primOpCodeSizeForeignCall = 4
528
529 {-
530 ************************************************************************
531 * *
532 PrimOp types
533 * *
534 ************************************************************************
535 -}
536
537 primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
538 primOpType op
539 = case primOpInfo op of
540 Dyadic _occ ty -> dyadic_fun_ty ty
541 Monadic _occ ty -> monadic_fun_ty ty
542 Compare _occ ty -> compare_fun_ty ty
543
544 GenPrimOp _occ tyvars arg_tys res_ty ->
545 mkSpecForAllTys tyvars (mkFunTys arg_tys res_ty)
546
547 primOpOcc :: PrimOp -> OccName
548 primOpOcc op = case primOpInfo op of
549 Dyadic occ _ -> occ
550 Monadic occ _ -> occ
551 Compare occ _ -> occ
552 GenPrimOp occ _ _ _ -> occ
553
554 -- primOpSig is like primOpType but gives the result split apart:
555 -- (type variables, argument types, result type)
556 -- It also gives arity, strictness info
557
558 primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
559 primOpSig op
560 = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
561 where
562 arity = length arg_tys
563 (tyvars, arg_tys, res_ty)
564 = case (primOpInfo op) of
565 Monadic _occ ty -> ([], [ty], ty )
566 Dyadic _occ ty -> ([], [ty,ty], ty )
567 Compare _occ ty -> ([], [ty,ty], intPrimTy)
568 GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty )
569
570 data PrimOpResultInfo
571 = ReturnsPrim PrimRep
572 | ReturnsAlg TyCon
573
574 -- Some PrimOps need not return a manifest primitive or algebraic value
575 -- (i.e. they might return a polymorphic value). These PrimOps *must*
576 -- be out of line, or the code generator won't work.
577
578 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
579 getPrimOpResultInfo op
580 = case (primOpInfo op) of
581 Dyadic _ ty -> ReturnsPrim (typePrimRep ty)
582 Monadic _ ty -> ReturnsPrim (typePrimRep ty)
583 Compare _ _ -> ReturnsPrim (tyConPrimRep intPrimTyCon)
584 GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
585 | otherwise -> ReturnsAlg tc
586 where
587 tc = tyConAppTyCon ty
588 -- All primops return a tycon-app result
589 -- The tycon can be an unboxed tuple or sum, though,
590 -- which gives rise to a ReturnAlg
591
592 {-
593 We do not currently make use of whether primops are commutable.
594
595 We used to try to move constants to the right hand side for strength
596 reduction.
597 -}
598
599 {-
600 commutableOp :: PrimOp -> Bool
601 #include "primop-commutable.hs-incl"
602 -}
603
604 -- Utils:
605
606 dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
607 dyadic_fun_ty ty = mkFunTys [ty, ty] ty
608 monadic_fun_ty ty = mkFunTy ty ty
609 compare_fun_ty ty = mkFunTys [ty, ty] intPrimTy
610
611 -- Output stuff:
612
613 pprPrimOp :: PrimOp -> SDoc
614 pprPrimOp other_op = pprOccName (primOpOcc other_op)
615
616 {-
617 ************************************************************************
618 * *
619 \subsubsection[PrimCall]{User-imported primitive calls}
620 * *
621 ************************************************************************
622 -}
623
624 data PrimCall = PrimCall CLabelString UnitId
625
626 instance Outputable PrimCall where
627 ppr (PrimCall lbl pkgId)
628 = text "__primcall" <+> ppr pkgId <+> ppr lbl