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