module GHC.Builtin.PrimOps.Ids
( primOpId
, allThePrimOpIds
)
where
import GHC.Prelude
import {-# SOURCE #-} GHC.Core.Opt.ConstantFold (primOpRules)
import GHC.Core.Type (mkForAllTys, mkVisFunTysMany, argsHaveFixedRuntimeRep )
import GHC.Core.FVs (mkRuleInfo)
import GHC.Builtin.PrimOps
import GHC.Builtin.Uniques
import GHC.Builtin.Names
import GHC.Types.Basic
import GHC.Types.Cpr
import GHC.Types.Demand
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.TyThing
import GHC.Types.Name
import GHC.Data.SmallArray
import Data.Maybe ( maybeToList )
mkPrimOpId :: PrimOp -> Id
mkPrimOpId :: PrimOp -> Id
mkPrimOpId PrimOp
prim_op
= Id
id
where
([TyVarBinder]
tyvars,[Type]
arg_tys,Type
res_ty, Int
arity, DmdSig
strict_sig) = PrimOp -> ([TyVarBinder], [Type], Type, Int, DmdSig)
primOpSig PrimOp
prim_op
ty :: Type
ty = [TyVarBinder] -> Type -> Type
mkForAllTys [TyVarBinder]
tyvars ([Type] -> Type -> Type
mkVisFunTysMany [Type]
arg_tys Type
res_ty)
name :: Name
name = Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
gHC_PRIM (PrimOp -> OccName
primOpOcc PrimOp
prim_op)
(Int -> Unique
mkPrimOpIdUnique (PrimOp -> Int
primOpTag PrimOp
prim_op))
(Id -> TyThing
AnId Id
id) BuiltInSyntax
UserSyntax
id :: Id
id = IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId (PrimOp -> Bool -> IdDetails
PrimOpId PrimOp
prim_op Bool
lev_poly) Name
name Type
ty IdInfo
info
lev_poly :: Bool
lev_poly = Bool -> Bool
not (Type -> Bool
argsHaveFixedRuntimeRep Type
ty)
cpr :: Cpr
cpr
| Divergence -> Bool
isDeadEndDiv (([Demand], Divergence) -> Divergence
forall a b. (a, b) -> b
snd (DmdSig -> ([Demand], Divergence)
splitDmdSig DmdSig
strict_sig)) = Cpr
botCpr
| Bool
otherwise = Cpr
topCpr
info :: IdInfo
info = IdInfo
noCafIdInfo
IdInfo -> RuleInfo -> IdInfo
`setRuleInfo` [CoreRule] -> RuleInfo
mkRuleInfo (Maybe CoreRule -> [CoreRule]
forall a. Maybe a -> [a]
maybeToList (Maybe CoreRule -> [CoreRule]) -> Maybe CoreRule -> [CoreRule]
forall a b. (a -> b) -> a -> b
$ Name -> PrimOp -> Maybe CoreRule
primOpRules Name
name PrimOp
prim_op)
IdInfo -> Int -> IdInfo
`setArityInfo` Int
arity
IdInfo -> DmdSig -> IdInfo
`setDmdSigInfo` DmdSig
strict_sig
IdInfo -> CprSig -> IdInfo
`setCprSigInfo` Int -> Cpr -> CprSig
mkCprSig Int
arity Cpr
cpr
IdInfo -> InlinePragma -> IdInfo
`setInlinePragInfo` InlinePragma
neverInlinePragma
primOpIds :: SmallArray Id
{-# NOINLINE primOpIds #-}
primOpIds :: SmallArray Id
primOpIds = Int
-> (PrimOp -> Int) -> (PrimOp -> Id) -> [PrimOp] -> SmallArray Id
forall e a. Int -> (e -> Int) -> (e -> a) -> [e] -> SmallArray a
listToArray (Int
maxPrimOpTagInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) PrimOp -> Int
primOpTag PrimOp -> Id
mkPrimOpId [PrimOp]
allThePrimOps
primOpId :: PrimOp -> Id
{-# INLINE primOpId #-}
primOpId :: PrimOp -> Id
primOpId PrimOp
op = SmallArray Id -> Int -> Id
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Id
primOpIds (PrimOp -> Int
primOpTag PrimOp
op)
allThePrimOpIds :: [Id]
{-# INLINE allThePrimOpIds #-}
allThePrimOpIds :: [Id]
allThePrimOpIds = (Int -> Id) -> [Int] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map (SmallArray Id -> Int -> Id
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Id
primOpIds) [Int
0..Int
maxPrimOpTag]