Implement unboxed sum primitive type
[ghc.git] / compiler / vectorise / Vectorise / Builtins / Base.hs
1 -- |Builtin types and functions used by the vectoriser. These are all defined in
2 -- 'Data.Array.Parallel.Prim'.
3
4 module Vectorise.Builtins.Base (
5 -- * Hard config
6 mAX_DPH_PROD,
7 mAX_DPH_SUM,
8 mAX_DPH_COMBINE,
9 mAX_DPH_SCALAR_ARGS,
10 aLL_DPH_PRIM_TYCONS,
11
12 -- * Builtins
13 Builtins(..),
14
15 -- * Projections
16 selTy, selsTy,
17 selReplicate,
18 selTags,
19 selElements,
20 selsLength,
21 sumTyCon,
22 prodTyCon,
23 prodDataCon,
24 replicatePD_PrimVar,
25 emptyPD_PrimVar,
26 packByTagPD_PrimVar,
27 combinePDVar,
28 combinePD_PrimVar,
29 scalarZip,
30 closureCtrFun
31 ) where
32
33 import TysPrim
34 import BasicTypes
35 import Class
36 import CoreSyn
37 import TysWiredIn hiding (sumTyCon)
38 import Type
39 import TyCon
40 import DataCon
41 import NameEnv
42 import Name
43 import Outputable
44
45 import Data.Array
46
47
48 -- Cardinality of the various families of types and functions exported by the DPH library.
49
50 mAX_DPH_PROD :: Int
51 mAX_DPH_PROD = 5
52
53 mAX_DPH_SUM :: Int
54 mAX_DPH_SUM = 2
55
56 mAX_DPH_COMBINE :: Int
57 mAX_DPH_COMBINE = 2
58
59 mAX_DPH_SCALAR_ARGS :: Int
60 mAX_DPH_SCALAR_ARGS = 8
61
62 -- Types from 'GHC.Prim' supported by DPH
63 --
64 aLL_DPH_PRIM_TYCONS :: [Name]
65 aLL_DPH_PRIM_TYCONS = map tyConName [intPrimTyCon, {- floatPrimTyCon, -} doublePrimTyCon]
66
67
68 -- |Holds the names of the types and functions from 'Data.Array.Parallel.Prim' that are used by the
69 -- vectoriser.
70 --
71 data Builtins
72 = Builtins
73 { parrayTyCon :: TyCon -- ^ PArray
74 , pdataTyCon :: TyCon -- ^ PData
75 , pdatasTyCon :: TyCon -- ^ PDatas
76 , prClass :: Class -- ^ PR
77 , prTyCon :: TyCon -- ^ PR
78 , preprTyCon :: TyCon -- ^ PRepr
79 , paClass :: Class -- ^ PA
80 , paTyCon :: TyCon -- ^ PA
81 , paDataCon :: DataCon -- ^ PA
82 , paPRSel :: Var -- ^ PA
83 , replicatePDVar :: Var -- ^ replicatePD
84 , replicatePD_PrimVars :: NameEnv Var -- ^ replicatePD_Int# etc.
85 , emptyPDVar :: Var -- ^ emptyPD
86 , emptyPD_PrimVars :: NameEnv Var -- ^ emptyPD_Int# etc.
87 , packByTagPDVar :: Var -- ^ packByTagPD
88 , packByTagPD_PrimVars :: NameEnv Var -- ^ packByTagPD_Int# etc.
89 , combinePDVars :: Array Int Var -- ^ combinePD
90 , combinePD_PrimVarss :: Array Int (NameEnv Var) -- ^ combine2PD_Int# etc.
91 , scalarClass :: Class -- ^ Scalar
92 , scalarZips :: Array Int Var -- ^ map, zipWith, zipWith3
93 , voidTyCon :: TyCon -- ^ Void
94 , voidVar :: Var -- ^ void
95 , fromVoidVar :: Var -- ^ fromVoid
96 , sumTyCons :: Array Int TyCon -- ^ Sum2 .. Sum3
97 , wrapTyCon :: TyCon -- ^ Wrap
98 , pvoidVar :: Var -- ^ pvoid
99 , pvoidsVar :: Var -- ^ pvoids
100 , closureTyCon :: TyCon -- ^ :->
101 , closureVar :: Var -- ^ closure
102 , liftedClosureVar :: Var -- ^ liftedClosure
103 , applyVar :: Var -- ^ $:
104 , liftedApplyVar :: Var -- ^ liftedApply
105 , closureCtrFuns :: Array Int Var -- ^ closure1 .. closure3
106 , selTys :: Array Int Type -- ^ Sel2
107 , selsTys :: Array Int Type -- ^ Sels2
108 , selsLengths :: Array Int CoreExpr -- ^ lengthSels2
109 , selReplicates :: Array Int CoreExpr -- ^ replicate2
110 , selTagss :: Array Int CoreExpr -- ^ tagsSel2
111 , selElementss :: Array (Int, Int) CoreExpr -- ^ elementsSel2_0 .. elementsSel_2_1
112 , liftingContext :: Var -- ^ lc
113 }
114
115
116 -- Projections ----------------------------------------------------------------
117 -- We use these wrappers instead of indexing the `Builtin` structure directly
118 -- because they give nicer panic messages if the indexed thing cannot be found.
119
120 selTy :: Int -> Builtins -> Type
121 selTy = indexBuiltin "selTy" selTys
122
123 selsTy :: Int -> Builtins -> Type
124 selsTy = indexBuiltin "selsTy" selsTys
125
126 selsLength :: Int -> Builtins -> CoreExpr
127 selsLength = indexBuiltin "selLength" selsLengths
128
129 selReplicate :: Int -> Builtins -> CoreExpr
130 selReplicate = indexBuiltin "selReplicate" selReplicates
131
132 selTags :: Int -> Builtins -> CoreExpr
133 selTags = indexBuiltin "selTags" selTagss
134
135 selElements :: Int -> Int -> Builtins -> CoreExpr
136 selElements i j = indexBuiltin "selElements" selElementss (i, j)
137
138 sumTyCon :: Int -> Builtins -> TyCon
139 sumTyCon = indexBuiltin "sumTyCon" sumTyCons
140
141 prodTyCon :: Int -> Builtins -> TyCon
142 prodTyCon n _
143 | n >= 2 && n <= mAX_DPH_PROD
144 = tupleTyCon Boxed n
145 | otherwise
146 = pprPanic "prodTyCon" (ppr n)
147
148 prodDataCon :: Int -> Builtins -> DataCon
149 prodDataCon n bi
150 = case tyConDataCons (prodTyCon n bi) of
151 [con] -> con
152 _ -> pprPanic "prodDataCon" (ppr n)
153
154 replicatePD_PrimVar :: TyCon -> Builtins -> Var
155 replicatePD_PrimVar tc bi
156 = lookupEnvBuiltin "replicatePD_PrimVar" (replicatePD_PrimVars bi) (tyConName tc)
157
158 emptyPD_PrimVar :: TyCon -> Builtins -> Var
159 emptyPD_PrimVar tc bi
160 = lookupEnvBuiltin "emptyPD_PrimVar" (emptyPD_PrimVars bi) (tyConName tc)
161
162 packByTagPD_PrimVar :: TyCon -> Builtins -> Var
163 packByTagPD_PrimVar tc bi
164 = lookupEnvBuiltin "packByTagPD_PrimVar" (packByTagPD_PrimVars bi) (tyConName tc)
165
166 combinePDVar :: Int -> Builtins -> Var
167 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
168
169 combinePD_PrimVar :: Int -> TyCon -> Builtins -> Var
170 combinePD_PrimVar i tc bi
171 = lookupEnvBuiltin "combinePD_PrimVar"
172 (indexBuiltin "combinePD_PrimVar" combinePD_PrimVarss i bi) (tyConName tc)
173
174 scalarZip :: Int -> Builtins -> Var
175 scalarZip = indexBuiltin "scalarZip" scalarZips
176
177 closureCtrFun :: Int -> Builtins -> Var
178 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
179
180 -- | Get an element from one of the arrays of `Builtins`.
181 -- Panic if the indexed thing is not in the array.
182 indexBuiltin :: (Ix i, Outputable i)
183 => String -- ^ Name of the selector we've used, for panic messages.
184 -> (Builtins -> Array i a) -- ^ Field selector for the `Builtins`.
185 -> i -- ^ Index into the array.
186 -> Builtins
187 -> a
188 indexBuiltin fn f i bi
189 | inRange (bounds xs) i = xs ! i
190 | otherwise
191 = pprSorry "Vectorise.Builtins.indexBuiltin"
192 (vcat [ text ""
193 , text "DPH builtin function '" <> text fn <> text "' of size '" <> ppr i <>
194 text "' is not yet implemented."
195 , text "This function does not appear in your source program, but it is needed"
196 , text "to compile your code in the backend. This is a known, current limitation"
197 , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org"
198 , text "and ask what you can do to help (it might involve some GHC hacking)."])
199 where xs = f bi
200
201
202 -- | Get an entry from one of a 'NameEnv' of `Builtins`. Panic if the named item is not in the array.
203 lookupEnvBuiltin :: String -- Function name for error messages
204 -> NameEnv a -- Name environment
205 -> Name -- Index into the name environment
206 -> a
207 lookupEnvBuiltin fn env n
208 | Just r <- lookupNameEnv env n = r
209 | otherwise
210 = pprSorry "Vectorise.Builtins.lookupEnvBuiltin"
211 (vcat [ text ""
212 , text "DPH builtin function '" <> text fn <> text "_" <> ppr n <>
213 text "' is not yet implemented."
214 , text "This function does not appear in your source program, but it is needed"
215 , text "to compile your code in the backend. This is a known, current limitation"
216 , text "of DPH. If you want it to work, you should send mail to ghc-commits@haskell.org"
217 , text "and ask what you can do to help (it might involve some GHC hacking)."])