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