module GHC.Builtin.PrimOps.Ids
( primOpId
, allThePrimOpIds
)
where
import GHC.Prelude
import GHC.Core.Opt.ConstantFold (primOpRules)
import GHC.Core.Type (mkForAllTys, mkVisFunTysMany)
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 prim_op
= id
where
(tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
ty = mkForAllTys tyvars (mkVisFunTysMany arg_tys res_ty)
name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
(mkPrimOpIdUnique (primOpTag prim_op))
(AnId id) UserSyntax
id = mkGlobalId (PrimOpId prim_op) name ty info
cpr
| isDeadEndDiv (snd (splitDmdSig strict_sig)) = botCpr
| otherwise = topCpr
info = noCafIdInfo
`setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op)
`setArityInfo` arity
`setDmdSigInfo` strict_sig
`setCprSigInfo` mkCprSig arity cpr
`setInlinePragInfo` neverInlinePragma
`setLevityInfoWithType` res_ty
primOpIds :: SmallArray Id
primOpIds = listToArray (maxPrimOpTag+1) primOpTag mkPrimOpId allThePrimOps
primOpId :: PrimOp -> Id
primOpId op = indexSmallArray primOpIds (primOpTag op)
allThePrimOpIds :: [Id]
allThePrimOpIds = map (indexSmallArray primOpIds) [0..maxPrimOpTag]