-- | PrimOp's Ids
module GHC.Builtin.PrimOps.Ids
  ( primOpId
  , allThePrimOpIds
  )
where

import GHC.Prelude

-- primop rules are attached to primop ids
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 )


-- | Build a PrimOp Id
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)

    -- PrimOps don't ever construct a product, but we want to preserve bottoms
    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
               -- We give PrimOps a NOINLINE pragma so that we don't
               -- get silly warnings from Desugar.dsRule (the inline_shadows_rule
               -- test) about a RULE conflicting with a possible inlining
               -- cf #7287


-------------------------------------------------------------
-- Cache of PrimOp's Ids
-------------------------------------------------------------

-- | A cache of the PrimOp Ids, indexed by PrimOp tag (0 indexed)
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

-- | Get primop id.
--
-- Retrieve it from `primOpIds` cache.
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)

-- | All the primop ids, as a list
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]