-- | 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)
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 -> IdDetails
PrimOpId PrimOp
prim_op) Name
name Type
ty IdInfo
info

    -- 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
           IdInfo -> Type -> IdInfo
`setLevityInfoWithType` Type
res_ty
               -- 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]