\begin{code}
module PrimOp (
PrimOp(..), allThePrimOps,
- tagOf_PrimOp, -- ToDo: rm
primOpType, primOpSig, primOpUsg,
- primOpUniq, primOpOcc,
+ mkPrimOpIdName, primOpRdrName, primOpTag,
commutableOp,
primOpOutOfLine, primOpNeedsWrapper, primOpStrictness,
- primOpOkForSpeculation, primOpIsCheap,
+ primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
primOpHasSideEffects,
getPrimOpResultInfo, PrimOpResultInfo(..),
import TysWiredIn
import Demand ( Demand, wwLazy, wwPrim, wwStrict )
-import Var ( TyVar )
+import Var ( TyVar, Id )
import CallConv ( CallConv, pprCallConv )
import PprType ( pprParendType )
+import Name ( Name, mkWiredInIdName )
+import RdrName ( RdrName, mkRdrQual )
import OccName ( OccName, pprOccName, mkSrcVarOcc )
import TyCon ( TyCon, tyConArity )
import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys,
- mkTyConTy, mkTyConApp, typePrimRep,
+ mkTyConTy, mkTyConApp, typePrimRep,mkTyVarTy,
splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe,
UsageAnn(..), mkUsgTy
)
import Unique ( Unique, mkPrimOpIdUnique )
+import PrelMods ( pREL_GHC, pREL_GHC_Name )
import Outputable
import Util ( assoc, zipWithEqual )
import GlaExts ( Int(..), Int#, (==#) )
Used for the Ord instance
\begin{code}
+primOpTag :: PrimOp -> Int
+primOpTag op = IBOX( tagOf_PrimOp op )
+
tagOf_PrimOp CharGtOp = (ILIT( 1) :: FAST_INT)
tagOf_PrimOp CharGeOp = ILIT( 2)
tagOf_PrimOp CharEqOp = ILIT( 3)
-- the list of demands may be infinite!
-- Use only the ones you ned.
-primOpStrictness SeqOp = ([wwLazy], False)
+primOpStrictness SeqOp = ([wwStrict], False)
+ -- Seq is strict in its argument; see notes in ConFold.lhs
+
primOpStrictness ParOp = ([wwLazy], False)
+ -- But Par is lazy, to avoid that the sparked thing
+ -- gets evaluted strictly, which it should *not* be
+
primOpStrictness ForkOp = ([wwLazy, wwPrim], False)
primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False)
\begin{code}
primOpInfo MkWeakOp
- = mkGenPrimOp SLIT("mkWeak#") [alphaTyVar, betaTyVar, gammaTyVar]
- [alphaTy, betaTy, gammaTy, realWorldStatePrimTy]
+ = mkGenPrimOp SLIT("mkWeak#") [openAlphaTyVar, betaTyVar, gammaTyVar]
+ [mkTyVarTy openAlphaTyVar, betaTy, gammaTy, realWorldStatePrimTy]
(unboxedPair [realWorldStatePrimTy, mkWeakPrimTy betaTy])
\end{code}
primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op)
\end{code}
+primOpIsDupable means that the use of the primop is small enough to
+duplicate into different case branches. See CoreUtils.exprIsDupable.
+
+\begin{code}
+primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc
+ -- If the ccall can't GC then the call is pretty cheap, and
+ -- we're happy to duplicate
+primOpIsDupable op = not (primOpOutOfLine op)
+\end{code}
+
+
\begin{code}
primOpCanFail :: PrimOp -> Bool
-- Int.
\end{code}
\begin{code}
-primOpOcc op
- = case (primOpInfo op) of
- Dyadic occ _ -> occ
- Monadic occ _ -> occ
- Compare occ _ -> occ
- GenPrimOp occ _ _ _ -> occ
-\end{code}
-
-\begin{code}
-primOpUniq :: PrimOp -> Unique
-primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op))
-
primOpType :: PrimOp -> Type -- you may want to use primOpSig instead
primOpType op
= case (primOpInfo op) of
GenPrimOp occ tyvars arg_tys res_ty ->
mkForAllTys tyvars (mkFunTys arg_tys res_ty)
+mkPrimOpIdName :: PrimOp -> Id -> Name
+ -- Make the name for the PrimOp's Id
+ -- We have to pass in the Id itself because it's a WiredInId
+ -- and hence recursive
+mkPrimOpIdName op id
+ = mkWiredInIdName key pREL_GHC occ_name id
+ where
+ occ_name = primOpOcc op
+ key = mkPrimOpIdUnique (primOpTag op)
+
+
+primOpRdrName :: PrimOp -> RdrName
+primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
+
+primOpOcc :: PrimOp -> OccName
+primOpOcc op = case (primOpInfo op) of
+ Dyadic occ _ -> occ
+ Monadic occ _ -> occ
+ Compare occ _ -> occ
+ GenPrimOp occ _ _ _ -> occ
+
-- primOpSig is like primOpType but gives the result split apart:
-- (type variables, argument types, result type)