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