\begin{code}
module PrimOp (
PrimOp(..), allThePrimOps,
- primOpType, primOpSig, primOpUsg, primOpArity,
- mkPrimOpIdName, primOpRdrName, primOpTag, primOpOcc,
+ primOpType, primOpSig, primOpArity,
+ mkPrimOpIdName, primOpTag, primOpOcc,
commutableOp,
primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
primOpHasSideEffects,
- getPrimOpResultInfo, PrimOpResultInfo(..)
+ getPrimOpResultInfo, PrimOpResultInfo(..),
+
+ eqCharName, eqIntName, neqIntName,
+ ltCharName, eqWordName, ltWordName, eqAddrName, ltAddrName,
+ eqFloatName, ltFloatName, eqDoubleName, ltDoubleName,
+ ltIntName, geIntName, leIntName, minusIntName, tagToEnumName
) where
#include "HsVersions.h"
import NewDemand
import Var ( TyVar )
import Name ( Name, mkWiredInName )
-import RdrName ( RdrName, mkRdrOrig )
import OccName ( OccName, pprOccName, mkVarOcc )
import TyCon ( TyCon, isPrimTyCon, tyConPrimRep )
-import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep,
- splitFunTy_maybe, tyConAppTyCon, splitTyConApp,
- mkUTy, usOnce, usMany
- )
+import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep, tyConAppTyCon )
import PprType () -- get at Outputable Type instance.
import Unique ( mkPrimOpIdUnique )
import BasicTypes ( Arity, Boxity(..) )
-import PrelNames ( pREL_GHC, pREL_GHC_Name )
+import PrelNames ( gHC_PRIM )
import Outputable
-import Util ( zipWithEqual )
import FastTypes
\end{code}
-- We have to pass in the Id itself because it's a WiredInId
-- and hence recursive
mkPrimOpIdName op
- = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
-
-primOpRdrName :: PrimOp -> RdrName
-primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
+ = mkWiredInName gHC_PRIM (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
primOpOcc :: PrimOp -> OccName
primOpOcc op = case (primOpInfo op) of
Compare occ ty -> ([], [ty,ty], boolTy)
GenPrimOp occ tyvars arg_tys res_ty
-> (tyvars, arg_tys, res_ty)
-
--- primOpUsg is like primOpSig but the types it yields are the
--- appropriate sigma (i.e., usage-annotated) types,
--- as required by the UsageSP inference.
-
-primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
-#include "primop-usage.hs-incl"
-
--- Things with no Haskell pointers inside: in actuality, usages are
--- irrelevant here (hence it doesn't matter that some of these
--- apparently permit duplication; since such arguments are never
--- ENTERed anyway, the usage annotation they get is entirely irrelevant
--- except insofar as it propagates to infect other values that *are*
--- pointed.
-
-
--- Helper bits & pieces for usage info.
-
-mkZ = mkUTy usOnce -- pointed argument used zero
-mkO = mkUTy usOnce -- pointed argument used once
-mkM = mkUTy usMany -- pointed argument used multiply
-mkP = mkUTy usOnce -- unpointed argument
-mkR = mkUTy usMany -- unpointed result
-
-nomangle op
- = case primOpSig op of
- (tyvars, arg_tys, res_ty, _, _)
- -> (tyvars, map mkP arg_tys, mkR res_ty)
-
-mangle op fs g
- = case primOpSig op of
- (tyvars, arg_tys, res_ty, _, _)
- -> (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
-
-inFun op f g ty
- = case splitFunTy_maybe ty of
- Just (a,b) -> mkFunTy (f a) (g b)
- Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
-
-inUB op fs ty
- = case splitTyConApp ty of
- (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
- mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" ($) fs tys)
\end{code}
\begin{code}
Output stuff:
\begin{code}
pprPrimOp :: PrimOp -> SDoc
-pprPrimOp other_op
- = getPprStyle $ \ sty ->
- if ifaceStyle sty then -- For interfaces Print it qualified with PrelGHC.
- ptext SLIT("PrelGHC.") <> pprOccName occ
- else
- pprOccName occ
- where
- occ = primOpOcc other_op
+pprPrimOp other_op = pprOccName (primOpOcc other_op)
\end{code}
+%************************************************************************
+%* *
+ Names for some primops (for ndpFlatten/FlattenMonad.lhs)
+%* *
+%************************************************************************
+
+\begin{code}
+eqIntName = mkPrimOpIdName IntEqOp
+ltIntName = mkPrimOpIdName IntLtOp
+geIntName = mkPrimOpIdName IntGeOp
+leIntName = mkPrimOpIdName IntLeOp
+neqIntName = mkPrimOpIdName IntNeOp
+minusIntName = mkPrimOpIdName IntSubOp
+
+eqCharName = mkPrimOpIdName CharEqOp
+ltCharName = mkPrimOpIdName CharLtOp
+
+eqFloatName = mkPrimOpIdName FloatEqOp
+ltFloatName = mkPrimOpIdName FloatLtOp
+
+eqDoubleName = mkPrimOpIdName DoubleEqOp
+ltDoubleName = mkPrimOpIdName DoubleLtOp
+
+eqWordName = mkPrimOpIdName WordEqOp
+ltWordName = mkPrimOpIdName WordLtOp
+
+eqAddrName = mkPrimOpIdName AddrEqOp
+ltAddrName = mkPrimOpIdName AddrLtOp
+
+tagToEnumName = mkPrimOpIdName TagToEnumOp
+\end{code}