1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
-- | 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 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 lev_poly) name ty info
lev_poly = not (argsHaveFixedRuntimeRep ty)
-- PrimOps don't ever construct a product, but we want to preserve bottoms
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
-- 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 = listToArray (maxPrimOpTag+1) primOpTag mkPrimOpId allThePrimOps
-- | Get primop id.
--
-- Retrieve it from `primOpIds` cache.
primOpId :: PrimOp -> Id
{-# INLINE primOpId #-}
primOpId op = indexSmallArray primOpIds (primOpTag op)
-- | All the primop ids, as a list
allThePrimOpIds :: [Id]
{-# INLINE allThePrimOpIds #-}
allThePrimOpIds = map (indexSmallArray primOpIds) [0..maxPrimOpTag]
|
