PrimOp.hs 26 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

4
\section[PrimOp]{Primitive operations (machine-level)}
Austin Seipp's avatar
Austin Seipp committed
5
-}
6

7 8
{-# LANGUAGE CPP #-}

9 10 11
-- The default is a bit too low for the quite large primOpInfo definition
{-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}

12
module PrimOp (
13
        PrimOp(..), PrimOpVecCat(..), allThePrimOps,
14 15
        primOpType, primOpSig,
        primOpTag, maxPrimOpTag, primOpOcc,
16
        primOpWrapperId,
17

18
        tagToEnumKey,
19

20
        primOpOutOfLine, primOpCodeSize,
21
        primOpOkForSpeculation, primOpOkForSideEffects,
22
        primOpIsCheap, primOpFixity,
23

24
        getPrimOpResultInfo,  isComparisonPrimOp, PrimOpResultInfo(..),
25 26

        PrimCall(..)
27 28 29 30
    ) where

#include "HsVersions.h"

31 32
import GhcPrelude

33 34 35
import TysPrim
import TysWiredIn

36
import CmmType
37
import Demand
38 39 40 41
import Id               ( Id, mkVanillaGlobalWithInfo )
import IdInfo           ( vanillaIdInfo, setCafInfo, CafInfo(NoCafRefs) )
import Name
import PrelNames        ( gHC_PRIMOPWRAPPERS )
42
import TyCon            ( TyCon, isPrimTyCon, PrimRep(..) )
43
import Type
Richard Eisenberg's avatar
Richard Eisenberg committed
44
import RepType          ( typePrimRep1, tyConPrimRep1 )
Alan Zimmerman's avatar
Alan Zimmerman committed
45 46
import BasicTypes       ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
                          SourceText(..) )
47
import SrcLoc           ( wiredInSrcSpan )
48
import ForeignCall      ( CLabelString )
49
import Unique           ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
50
import Outputable
51
import FastString
52
import Module           ( UnitId )
53

Austin Seipp's avatar
Austin Seipp committed
54 55 56
{-
************************************************************************
*                                                                      *
57
\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
Austin Seipp's avatar
Austin Seipp committed
58 59
*                                                                      *
************************************************************************
60 61

These are in \tr{state-interface.verb} order.
Austin Seipp's avatar
Austin Seipp committed
62
-}
63

64
-- supplies:
65
-- data PrimOp = ...
66
#include "primop-data-decl.hs-incl"
67

68
-- supplies
69
-- primOpTag :: PrimOp -> Int
70
#include "primop-tag.hs-incl"
71
primOpTag _ = error "primOpTag: unknown primop"
72

73

74
instance Eq PrimOp where
75
    op1 == op2 = primOpTag op1 == primOpTag op2
76 77

instance Ord PrimOp where
78 79 80 81
    op1 <  op2 =  primOpTag op1 < primOpTag op2
    op1 <= op2 =  primOpTag op1 <= primOpTag op2
    op1 >= op2 =  primOpTag op1 >= primOpTag op2
    op1 >  op2 =  primOpTag op1 > primOpTag op2
82
    op1 `compare` op2 | op1 < op2  = LT
83 84
                      | op1 == op2 = EQ
                      | otherwise  = GT
85 86 87 88

instance Outputable PrimOp where
    ppr op = pprPrimOp op

89 90 91 92
data PrimOpVecCat = IntVec
                  | WordVec
                  | FloatVec

Austin Seipp's avatar
Austin Seipp committed
93
-- An @Enum@-derived list would be better; meanwhile... (ToDo)
94

95 96
allThePrimOps :: [PrimOp]
allThePrimOps =
97
#include "primop-list.hs-incl"
98

99 100 101
tagToEnumKey :: Unique
tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp)

Austin Seipp's avatar
Austin Seipp committed
102 103 104
{-
************************************************************************
*                                                                      *
105
\subsection[PrimOp-info]{The essential info about each @PrimOp@}
Austin Seipp's avatar
Austin Seipp committed
106 107
*                                                                      *
************************************************************************
108 109 110 111 112 113 114 115 116 117

The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
refer to the primitive operation.  The conventional \tr{#}-for-
unboxed ops is added on later.

The reason for the funny characters in the names is so we do not
interfere with the programmer's Haskell name spaces.

We use @PrimKinds@ for the ``type'' information, because they're
(slightly) more convenient to use than @TyCons@.
Austin Seipp's avatar
Austin Seipp committed
118 119
-}

120
data PrimOpInfo
121 122 123 124
  = Dyadic      OccName         -- string :: T -> T -> T
                Type
  | Monadic     OccName         -- string :: T -> T
                Type
125
  | Compare     OccName         -- string :: T -> T -> Int#
126 127 128 129 130
                Type
  | GenPrimOp   OccName         -- string :: \/a1..an . T1 -> .. -> Tk -> T
                [TyVar]
                [Type]
                Type
131

132
mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo
133 134 135
mkDyadic str  ty = Dyadic  (mkVarOccFS str) ty
mkMonadic str ty = Monadic (mkVarOccFS str) ty
mkCompare str ty = Compare (mkVarOccFS str) ty
136 137

mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo
138
mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
139

Austin Seipp's avatar
Austin Seipp committed
140 141 142
{-
************************************************************************
*                                                                      *
143
\subsubsection{Strictness}
Austin Seipp's avatar
Austin Seipp committed
144 145
*                                                                      *
************************************************************************
146 147

Not all primops are strict!
Austin Seipp's avatar
Austin Seipp committed
148
-}
149

150
primOpStrictness :: PrimOp -> Arity -> StrictSig
151 152 153
        -- See Demand.StrictnessInfo for discussion of what the results
        -- The arity should be the arity of the primop; that's why
        -- this function isn't exported.
154
#include "primop-strictness.hs-incl"
155

Austin Seipp's avatar
Austin Seipp committed
156 157 158
{-
************************************************************************
*                                                                      *
159
\subsubsection{Fixity}
Austin Seipp's avatar
Austin Seipp committed
160 161 162
*                                                                      *
************************************************************************
-}
163 164 165 166

primOpFixity :: PrimOp -> Maybe Fixity
#include "primop-fixity.hs-incl"

Austin Seipp's avatar
Austin Seipp committed
167 168 169
{-
************************************************************************
*                                                                      *
170
\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
Austin Seipp's avatar
Austin Seipp committed
171 172
*                                                                      *
************************************************************************
173 174 175

@primOpInfo@ gives all essential information (from which everything
else, notably a type, can be constructed) for each @PrimOp@.
Austin Seipp's avatar
Austin Seipp committed
176
-}
177 178

primOpInfo :: PrimOp -> PrimOpInfo
179
#include "primop-primop-info.hs-incl"
180
primOpInfo _ = error "primOpInfo: unknown primop"
181

Austin Seipp's avatar
Austin Seipp committed
182
{-
183
Here are a load of comments from the old primOp info:
184 185 186 187 188 189 190 191

A @Word#@ is an unsigned @Int#@.

@decodeFloat#@ is given w/ Integer-stuff (it's similar).

@decodeDouble#@ is given w/ Integer-stuff (it's similar).

Decoding of floating-point numbers is sorta Integer-related.  Encoding
192
is done with plain ccalls now (see PrelNumExtra.hs).
193 194 195

A @Weak@ Pointer is created by the @mkWeak#@ primitive:

196 197
        mkWeak# :: k -> v -> f -> State# RealWorld
                        -> (# State# RealWorld, Weak# v #)
198 199 200

In practice, you'll use the higher-level

201 202
        data Weak v = Weak# v
        mkWeak :: k -> v -> IO () -> IO (Weak v)
203 204 205 206 207

The following operation dereferences a weak pointer.  The weak pointer
may have been finalized, so the operation returns a result code which
must be inspected before looking at the dereferenced value.

208 209
        deRefWeak# :: Weak# v -> State# RealWorld ->
                        (# State# RealWorld, v, Int# #)
210 211 212 213 214

Only look at v if the Int# returned is /= 0 !!

The higher-level op is

215
        deRefWeak :: Weak v -> IO (Maybe v)
216 217

Weak pointers can be finalized early by using the finalize# operation:
218 219 220

        finalizeWeak# :: Weak# v -> State# RealWorld ->
                           (# State# RealWorld, Int#, IO () #)
221 222 223

The Int# returned is either

224 225
        0 if the weak pointer has already been finalized, or it has no
          finalizer (the third component is then invalid).
226

227 228
        1 if the weak pointer is still alive, with the finalizer returned
          as the third component.
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265

A {\em stable name/pointer} is an index into a table of stable name
entries.  Since the garbage collector is told about stable pointers,
it is safe to pass a stable pointer to external systems such as C
routines.

\begin{verbatim}
makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld
deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#
\end{verbatim}

It may seem a bit surprising that @makeStablePtr#@ is a @IO@
operation since it doesn't (directly) involve IO operations.  The
reason is that if some optimisation pass decided to duplicate calls to
@makeStablePtr#@ and we only pass one of the stable pointers over, a
massive space leak can result.  Putting it into the IO monad
prevents this.  (Another reason for putting them in a monad is to
ensure correct sequencing wrt the side-effecting @freeStablePtr@
operation.)

An important property of stable pointers is that if you call
makeStablePtr# twice on the same object you get the same stable
pointer back.

Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
besides, it's not likely to be used from Haskell) so it's not a
primop.

Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]

Stable Names
~~~~~~~~~~~~

A stable name is like a stable pointer, but with three important differences:

266 267 268
        (a) You can't deRef one to get back to the original object.
        (b) You can convert one to an Int.
        (c) You don't need to 'freeStableName'
269 270 271 272 273 274

The existence of a stable name doesn't guarantee to keep the object it
points to alive (unlike a stable pointer), hence (a).

Invariants:

275 276 277 278 279
        (a) makeStableName always returns the same value for a given
            object (same as stable pointers).

        (b) if two stable names are equal, it implies that the objects
            from which they were created were the same.
280

281 282
        (c) stableNameToInt always returns the same Int for a given
            stable name.
283 284


Krzysztof Gogolewski's avatar
Typos  
Krzysztof Gogolewski committed
285
These primops are pretty weird.
286

287
        tagToEnum# :: Int -> a    (result type must be an enumerated type)
288 289 290 291

The constraints aren't currently checked by the front end, but the
code generator will fall over if they aren't satisfied.

Austin Seipp's avatar
Austin Seipp committed
292 293
************************************************************************
*                                                                      *
294
            Which PrimOps are out-of-line
Austin Seipp's avatar
Austin Seipp committed
295 296
*                                                                      *
************************************************************************
297 298 299

Some PrimOps need to be called out-of-line because they either need to
perform a heap check or they block.
Austin Seipp's avatar
Austin Seipp committed
300
-}
301

apt's avatar
apt committed
302
primOpOutOfLine :: PrimOp -> Bool
303
#include "primop-out-of-line.hs-incl"
304

Austin Seipp's avatar
Austin Seipp committed
305 306 307
{-
************************************************************************
*                                                                      *
308
            Failure and side effects
Austin Seipp's avatar
Austin Seipp committed
309 310
*                                                                      *
************************************************************************
311

312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332
Note [Checking versus non-checking primops]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  In GHC primops break down into two classes:

   a. Checking primops behave, for instance, like division. In this
      case the primop may throw an exception (e.g. division-by-zero)
      and is consequently is marked with the can_fail flag described below.
      The ability to fail comes at the expense of precluding some optimizations.

   b. Non-checking primops behavior, for instance, like addition. While
      addition can overflow it does not produce an exception. So can_fail is
      set to False, and we get more optimisation opportunities.  But we must
      never throw an exception, so we cannot rewrite to a call to error.

  It is important that a non-checking primop never be transformed in a way that
  would cause it to bottom. Doing so would violate Core's let/app invariant
  (see Note [CoreSyn let/app invariant] in CoreSyn) which is critical to
  the simplifier's ability to float without fear of changing program meaning.


333 334
Note [PrimOp can_fail and has_side_effects]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
335 336 337
Both can_fail and has_side_effects mean that the primop has
some effect that is not captured entirely by its result value.

338 339 340 341 342 343 344 345 346 347 348 349 350 351
----------  has_side_effects ---------------------
A primop "has_side_effects" if it has some *write* effect, visible
elsewhere
    - writing to the world (I/O)
    - writing to a mutable data structure (writeIORef)
    - throwing a synchronous Haskell exception

Often such primops have a type like
   State -> input -> (State, output)
so the state token guarantees ordering.  In general we rely *only* on
data dependencies of the state token to enforce write-effect ordering

 * NB1: if you inline unsafePerformIO, you may end up with
   side-effecting ops whose 'state' output is discarded.
352
   And programmers may do that by hand; see #9390.
353 354 355 356 357 358 359 360 361 362
   That is why we (conservatively) do not discard write-effecting
   primops even if both their state and result is discarded.

 * NB2: We consider primops, such as raiseIO#, that can raise a
   (Haskell) synchronous exception to "have_side_effects" but not
   "can_fail".  We must be careful about not discarding such things;
   see the paper "A semantics for imprecise exceptions".

 * NB3: *Read* effects (like reading an IORef) don't count here,
   because it doesn't matter if we don't do them, or do them more than
363
   once.  *Sequencing* is maintained by the data dependency of the state
364 365 366
   token.

----------  can_fail ----------------------------
367
A primop "can_fail" if it can fail with an *unchecked* exception on
368
some elements of its input domain. Main examples:
369
   division (fails on zero demoninator)
370 371
   array indexing (fails if the index is out of bounds)

372 373
An "unchecked exception" is one that is an outright error, (not
turned into a Haskell exception,) such as seg-fault or
374 375
divide-by-zero error.  Such can_fail primops are ALWAYS surrounded
with a test that checks for the bad cases, but we need to be
376
very careful about code motion that might move it out of
377 378 379 380 381 382 383 384
the scope of the test.

Note [Transformations affected by can_fail and has_side_effects]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The can_fail and has_side_effects properties have the following effect
on program transformations.  Summary table is followed by details.

            can_fail     has_side_effects
385
Discard        YES           NO
386 387 388 389 390 391 392 393 394 395
Float in       YES           YES
Float out      NO            NO
Duplicate      YES           NO

* Discarding.   case (a `op` b) of _ -> rhs  ===>   rhs
  You should not discard a has_side_effects primop; e.g.
     case (writeIntArray# a i v s of (# _, _ #) -> True
  Arguably you should be able to discard this, since the
  returned stat token is not used, but that relies on NEVER
  inlining unsafePerformIO, and programmers sometimes write
396
  this kind of stuff by hand (#9390).  So we (conservatively)
397 398 399 400 401
  never discard a has_side_effects primop.

  However, it's fine to discard a can_fail primop.  For example
     case (indexIntArray# a i) of _ -> True
  We can discard indexIntArray#; it has can_fail, but not
402
  has_side_effects; see #5658 which was all about this.
403 404 405 406 407 408 409 410 411 412
  Notice that indexIntArray# is (in a more general handling of
  effects) read effect, but we don't care about that here, and
  treat read effects as *not* has_side_effects.

  Similarly (a `/#` b) can be discarded.  It can seg-fault or
  cause a hardware exception, but not a synchronous Haskell
  exception.



413
  Synchronous Haskell exceptions, e.g. from raiseIO#, are treated
414 415 416 417 418 419 420
  as has_side_effects and hence are not discarded.

* Float in.  You can float a can_fail or has_side_effects primop
  *inwards*, but not inside a lambda (see Duplication below).

* Float out.  You must not float a can_fail primop *outwards* lest
  you escape the dynamic scope of the test.  Example:
421 422 423 424 425 426 427 428 429
      case d ># 0# of
        True  -> case x /# d of r -> r +# 1
        False -> 0
  Here we must not float the case outwards to give
      case x/# d of r ->
      case d ># 0# of
        True  -> r +# 1
        False -> 0

430 431
  Nor can you float out a has_side_effects primop.  For example:
       if blah then case writeMutVar# v True s0 of (# s1 #) -> s1
432
               else s0
433
  Notice that s0 is mentioned in both branches of the 'if', but
434 435
  only one of these two will actually be consumed.  But if we
  float out to
436 437
      case writeMutVar# v True s0 of (# s1 #) ->
      if blah then s1 else s0
438 439 440
  the writeMutVar will be performed in both branches, which is
  utterly wrong.

441 442 443 444
* Duplication.  You cannot duplicate a has_side_effect primop.  You
  might wonder how this can occur given the state token threading, but
  just look at Control.Monad.ST.Lazy.Imp.strictToLazy!  We get
  something like this
445 446 447 448 449 450 451
        p = case readMutVar# s v of
              (# s', r #) -> (S# s', r)
        s' = case p of (s', r) -> s'
        r  = case p of (s', r) -> r

  (All these bindings are boxed.)  If we inline p at its two call
  sites, we get a catastrophe: because the read is performed once when
452
  s' is demanded, and once when 'r' is demanded, which may be much
453
  later.  Utterly wrong.  #3207 is real example of this happening.
454

455 456
  However, it's fine to duplicate a can_fail primop.  That is really
  the only difference between can_fail and has_side_effects.
457

458
Note [Implementation: how can_fail/has_side_effects affect transformations]
459 460 461
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
How do we ensure that that floating/duplication/discarding are done right
in the simplifier?
462

463 464 465
Two main predicates on primpops test these flags:
  primOpOkForSideEffects <=> not has_side_effects
  primOpOkForSpeculation <=> not (has_side_effects || can_fail)
466

467 468 469
  * The "no-float-out" thing is achieved by ensuring that we never
    let-bind a can_fail or has_side_effects primop.  The RHS of a
    let-binding (which can float in and out freely) satisfies
470 471
    exprOkForSpeculation; this is the let/app invariant.  And
    exprOkForSpeculation is false of can_fail and has_side_effects.
472

473
  * So can_fail and has_side_effects primops will appear only as the
474 475
    scrutinees of cases, and that's why the FloatIn pass is capable
    of floating case bindings inwards.
476

477 478
  * The no-duplicate thing is done via primOpIsCheap, by making
    has_side_effects things (very very very) not-cheap!
Austin Seipp's avatar
Austin Seipp committed
479
-}
480 481 482 483 484 485 486

primOpHasSideEffects :: PrimOp -> Bool
#include "primop-has-side-effects.hs-incl"

primOpCanFail :: PrimOp -> Bool
#include "primop-can-fail.hs-incl"

487
primOpOkForSpeculation :: PrimOp -> Bool
488
  -- See Note [PrimOp can_fail and has_side_effects]
489
  -- See comments with CoreUtils.exprOkForSpeculation
490
  -- primOpOkForSpeculation => primOpOkForSideEffects
491
primOpOkForSpeculation op
492 493 494
  =  primOpOkForSideEffects op
  && not (primOpOutOfLine op || primOpCanFail op)
    -- I think the "out of line" test is because out of line things can
495
    -- be expensive (eg sine, cosine), and so we may not want to speculate them
496 497 498 499

primOpOkForSideEffects :: PrimOp -> Bool
primOpOkForSideEffects op
  = not (primOpHasSideEffects op)
500

Austin Seipp's avatar
Austin Seipp committed
501
{-
502 503
Note [primOpIsCheap]
~~~~~~~~~~~~~~~~~~~~
504
@primOpIsCheap@, as used in \tr{SimplUtils.hs}.  For now (HACK
505 506 507 508
WARNING), we just borrow some other predicates for a
what-should-be-good-enough test.  "Cheap" means willing to call it more
than once, and/or push it inside a lambda.  The latter could change the
behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
Austin Seipp's avatar
Austin Seipp committed
509
-}
510 511

primOpIsCheap :: PrimOp -> Bool
512
-- See Note [PrimOp can_fail and has_side_effects]
513
primOpIsCheap op = primOpOkForSpeculation op
514 515
-- In March 2001, we changed this to
--      primOpIsCheap op = False
516
-- thereby making *no* primops seem cheap.  But this killed eta
517
-- expansion on case (x ==# y) of True -> \s -> ...
518
-- which is bad.  In particular a loop like
519
--      doLoop n = loop 0
520 521 522 523
--     where
--         loop i | i == n    = return ()
--                | otherwise = bar i >> loop (i+1)
-- allocated a closure every time round because it doesn't eta expand.
524
--
525
-- The problem that originally gave rise to the change was
526
--      let x = a +# b *# c in x +# x
527 528 529
-- were we don't want to inline x. But primopIsCheap doesn't control
-- that (it's exprIsDupable that does) so the problem doesn't occur
-- even if primOpIsCheap sometimes says 'True'.
530

Austin Seipp's avatar
Austin Seipp committed
531 532 533
{-
************************************************************************
*                                                                      *
534
               PrimOp code size
Austin Seipp's avatar
Austin Seipp committed
535 536
*                                                                      *
************************************************************************
537

538 539 540 541
primOpCodeSize
~~~~~~~~~~~~~~
Gives an indication of the code size of a primop, for the purposes of
calculating unfolding sizes; see CoreUnfold.sizeExpr.
Austin Seipp's avatar
Austin Seipp committed
542
-}
543

544 545 546 547 548 549 550
primOpCodeSize :: PrimOp -> Int
#include "primop-code-size.hs-incl"

primOpCodeSizeDefault :: Int
primOpCodeSizeDefault = 1
  -- CoreUnfold.primOpSize already takes into account primOpOutOfLine
  -- and adds some further costs for the args in that case.
551

552 553
primOpCodeSizeForeignCall :: Int
primOpCodeSizeForeignCall = 4
554

Austin Seipp's avatar
Austin Seipp committed
555 556 557
{-
************************************************************************
*                                                                      *
558
               PrimOp types
Austin Seipp's avatar
Austin Seipp committed
559 560 561
*                                                                      *
************************************************************************
-}
562 563 564

primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead
primOpType op
Ian Lynagh's avatar
Ian Lynagh committed
565 566 567 568
  = case primOpInfo op of
    Dyadic  _occ ty -> dyadic_fun_ty ty
    Monadic _occ ty -> monadic_fun_ty ty
    Compare _occ ty -> compare_fun_ty ty
569

570
    GenPrimOp _occ tyvars arg_tys res_ty ->
Simon Peyton Jones's avatar
Simon Peyton Jones committed
571
        mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)
572 573

primOpOcc :: PrimOp -> OccName
Ian Lynagh's avatar
Ian Lynagh committed
574 575 576 577 578
primOpOcc op = case primOpInfo op of
               Dyadic    occ _     -> occ
               Monadic   occ _     -> occ
               Compare   occ _     -> occ
               GenPrimOp occ _ _ _ -> occ
579

580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620
{- Note [Primop wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~
Previously hasNoBinding would claim that PrimOpIds didn't have a curried
function definition. This caused quite some trouble as we would be forced to
eta expand unsaturated primop applications very late in the Core pipeline. Not
only would this produce unnecessary thunks, but it would also result in nasty
inconsistencies in CAFfy-ness determinations (see #16846 and
Note [CAFfyness inconsistencies due to late eta expansion] in TidyPgm).

However, it was quite unnecessary for hasNoBinding to claim this; primops in
fact *do* have curried definitions which are found in GHC.PrimopWrappers, which
is auto-generated by utils/genprimops from prelude/primops.txt.pp. These wrappers
are standard Haskell functions mirroring the types of the primops they wrap.
For instance, in the case of plusInt# we would have:

    module GHC.PrimopWrappers where
    import GHC.Prim as P
    plusInt# a b = P.plusInt# a b

We now take advantage of these curried definitions by letting hasNoBinding
claim that PrimOpIds have a curried definition and then rewrite any unsaturated
PrimOpId applications that we find during CoreToStg as applications of the
associated wrapper (e.g. `GHC.Prim.plusInt# 3#` will get rewritten to
`GHC.PrimopWrappers.plusInt# 3#`).` The Id of the wrapper for a primop can be
found using 'PrimOp.primOpWrapperId'.

Nota Bene: GHC.PrimopWrappers is needed *regardless*, because it's
used by GHCi, which does not implement primops direct at all.

-}

-- | Returns the 'Id' of the wrapper associated with the given 'PrimOp'.
-- See Note [Primop wrappers].
primOpWrapperId :: PrimOp -> Id
primOpWrapperId op = mkVanillaGlobalWithInfo name ty info
  where
    info = setCafInfo vanillaIdInfo NoCafRefs
    name = mkExternalName uniq gHC_PRIMOPWRAPPERS (primOpOcc op) wiredInSrcSpan
    uniq = mkPrimOpWrapperUnique (primOpTag op)
    ty   = primOpType op

621 622 623 624 625
isComparisonPrimOp :: PrimOp -> Bool
isComparisonPrimOp op = case primOpInfo op of
                          Compare {} -> True
                          _          -> False

626 627
-- primOpSig is like primOpType but gives the result split apart:
-- (type variables, argument types, result type)
628
-- It also gives arity, strictness info
629

630
primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
631
primOpSig op
632
  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
633 634 635 636
  where
    arity = length arg_tys
    (tyvars, arg_tys, res_ty)
      = case (primOpInfo op) of
637 638 639 640
        Monadic   _occ ty                    -> ([],     [ty],    ty       )
        Dyadic    _occ ty                    -> ([],     [ty,ty], ty       )
        Compare   _occ ty                    -> ([],     [ty,ty], intPrimTy)
        GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty   )
641 642

data PrimOpResultInfo
643 644
  = ReturnsPrim     PrimRep
  | ReturnsAlg      TyCon
645 646 647 648 649 650 651 652

-- Some PrimOps need not return a manifest primitive or algebraic value
-- (i.e. they might return a polymorphic value).  These PrimOps *must*
-- be out of line, or the code generator won't work.

getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
getPrimOpResultInfo op
  = case (primOpInfo op) of
Richard Eisenberg's avatar
Richard Eisenberg committed
653 654 655 656
      Dyadic  _ ty                        -> ReturnsPrim (typePrimRep1 ty)
      Monadic _ ty                        -> ReturnsPrim (typePrimRep1 ty)
      Compare _ _                         -> ReturnsPrim (tyConPrimRep1 intPrimTyCon)
      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep1 tc)
657 658 659 660
                         | otherwise      -> ReturnsAlg tc
                         where
                           tc = tyConAppTyCon ty
                        -- All primops return a tycon-app result
661 662
                        -- The tycon can be an unboxed tuple or sum, though,
                        -- which gives rise to a ReturnAlg
663

Austin Seipp's avatar
Austin Seipp committed
664
{-
665 666 667 668
We do not currently make use of whether primops are commutable.

We used to try to move constants to the right hand side for strength
reduction.
Austin Seipp's avatar
Austin Seipp committed
669
-}
670

671
{-
672
commutableOp :: PrimOp -> Bool
673
#include "primop-commutable.hs-incl"
674
-}
675

Austin Seipp's avatar
Austin Seipp committed
676 677
-- Utils:

678
dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type
Simon Peyton Jones's avatar
Simon Peyton Jones committed
679 680 681
dyadic_fun_ty  ty = mkVisFunTys [ty, ty] ty
monadic_fun_ty ty = mkVisFunTy  ty ty
compare_fun_ty ty = mkVisFunTys [ty, ty] intPrimTy
682

Austin Seipp's avatar
Austin Seipp committed
683 684
-- Output stuff:

685
pprPrimOp  :: PrimOp -> SDoc
686
pprPrimOp other_op = pprOccName (primOpOcc other_op)
687

Austin Seipp's avatar
Austin Seipp committed
688 689 690
{-
************************************************************************
*                                                                      *
691
\subsubsection[PrimCall]{User-imported primitive calls}
Austin Seipp's avatar
Austin Seipp committed
692 693 694
*                                                                      *
************************************************************************
-}
695

696
data PrimCall = PrimCall CLabelString UnitId
697 698

instance Outputable PrimCall where
699 700
  ppr (PrimCall lbl pkgId)
        = text "__primcall" <+> ppr pkgId <+> ppr lbl