2 Builtins(..), sumTyCon, prodTyCon, prodDataCon,
3 selTy, selReplicate, selPick, selTags, selElements,
4 combinePDVar, scalarZip, closureCtrFun,
5 initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
6 initBuiltinPAs, initBuiltinPRs,
7 initBuiltinBoxedTyCons, initBuiltinScalars,
13 import IfaceEnv ( lookupOrig )
17 import DataCon ( DataCon, dataConName, dataConWorkId )
18 import TyCon ( TyCon, tyConName, tyConDataCons )
19 import Class ( Class, classTyCon )
20 import CoreSyn ( CoreExpr, Expr(..) )
22 import Id ( mkSysLocal )
23 import Name ( Name, getOccString )
27 import TypeRep ( funTyCon )
28 import Type ( Type, mkTyConApp )
30 import TysWiredIn ( unitDataCon,
34 boolTyCon, trueDataCon, falseDataCon,
36 import PrelNames ( word8TyConName, gHC_PARR )
37 import BasicTypes ( Boxity(..) )
43 import Control.Monad ( liftM, zipWithM )
44 import Data.List ( unzip4 )
52 mAX_DPH_COMBINE :: Int
55 mAX_DPH_SCALAR_ARGS :: Int
56 mAX_DPH_SCALAR_ARGS = 3
58 data Modules = Modules {
61 , dph_Closure :: Module
62 , dph_Unboxed :: Module
63 , dph_Instances :: Module
64 , dph_Combinators :: Module
65 , dph_Scalar :: Module
66 , dph_Selector :: Module
67 , dph_Prelude_PArr :: Module
68 , dph_Prelude_Int :: Module
69 , dph_Prelude_Word8 :: Module
70 , dph_Prelude_Double :: Module
71 , dph_Prelude_Bool :: Module
72 , dph_Prelude_Tuple :: Module
75 dph_Modules :: PackageId -> Modules
76 dph_Modules pkg = Modules {
77 dph_PArray = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
78 , dph_Repr = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
79 , dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
80 , dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
81 , dph_Instances = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
82 , dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
83 , dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
84 , dph_Selector = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
86 , dph_Prelude_PArr = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
87 , dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
88 , dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
89 , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
90 , dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
91 , dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
94 mk = mkModule pkg . mkModuleNameFS
96 dph_Orphans :: [Modules -> Module]
97 dph_Orphans = [dph_Repr, dph_Instances]
99 data Builtins = Builtins {
100 dphModules :: Modules
101 , parrayTyCon :: TyCon
102 , parrayDataCon :: DataCon
103 , pdataTyCon :: TyCon
105 , paDataCon :: DataCon
106 , preprTyCon :: TyCon
108 , prDataCon :: DataCon
111 , selTys :: Array Int Type
112 , selReplicates :: Array Int CoreExpr
113 , selPicks :: Array Int CoreExpr
114 , selTagss :: Array Int CoreExpr
115 , selEls :: Array (Int, Int) CoreExpr
116 , sumTyCons :: Array Int TyCon
117 , closureTyCon :: TyCon
124 , liftedClosureVar :: Var
125 , liftedApplyVar :: Var
126 , replicatePDVar :: Var
128 , packByTagPDVar :: Var
129 , combinePDVars :: Array Int Var
130 , scalarClass :: Class
131 , scalarZips :: Array Int Var
132 , closureCtrFuns :: Array Int Var
133 , liftingContext :: Var
136 indexBuiltin :: (Ix i, Outputable i) => String -> (Builtins -> Array i a)
137 -> i -> Builtins -> a
138 indexBuiltin fn f i bi
139 | inRange (bounds xs) i = xs ! i
140 | otherwise = pprPanic fn (ppr i)
144 selTy :: Int -> Builtins -> Type
145 selTy = indexBuiltin "selTy" selTys
147 selReplicate :: Int -> Builtins -> CoreExpr
148 selReplicate = indexBuiltin "selReplicate" selReplicates
150 selPick :: Int -> Builtins -> CoreExpr
151 selPick = indexBuiltin "selPick" selPicks
153 selTags :: Int -> Builtins -> CoreExpr
154 selTags = indexBuiltin "selTags" selTagss
156 selElements :: Int -> Int -> Builtins -> CoreExpr
157 selElements i j = indexBuiltin "selElements" selEls (i,j)
159 sumTyCon :: Int -> Builtins -> TyCon
160 sumTyCon = indexBuiltin "sumTyCon" sumTyCons
162 prodTyCon :: Int -> Builtins -> TyCon
164 | n >= 2 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
165 | otherwise = pprPanic "prodTyCon" (ppr n)
167 prodDataCon :: Int -> Builtins -> DataCon
168 prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
170 _ -> pprPanic "prodDataCon" (ppr n)
172 combinePDVar :: Int -> Builtins -> Var
173 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
175 scalarZip :: Int -> Builtins -> Var
176 scalarZip = indexBuiltin "scalarZip" scalarZips
178 closureCtrFun :: Int -> Builtins -> Var
179 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
181 initBuiltins :: PackageId -> DsM Builtins
184 mapM_ load dph_Orphans
185 parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray")
186 let [parrayDataCon] = tyConDataCons parrayTyCon
187 pdataTyCon <- externalTyCon dph_PArray (fsLit "PData")
188 paTyCon <- externalClassTyCon dph_PArray (fsLit "PA")
189 let [paDataCon] = tyConDataCons paTyCon
190 preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
191 prTyCon <- externalClassTyCon dph_PArray (fsLit "PR")
192 let [prDataCon] = tyConDataCons prTyCon
193 closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
195 voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
196 wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
197 sel_tys <- mapM (externalType dph_Selector)
198 (numbered "Sel" 2 mAX_DPH_SUM)
199 sel_replicates <- mapM (externalFun dph_Selector)
200 (numbered "replicate" 2 mAX_DPH_SUM)
201 sel_picks <- mapM (externalFun dph_Selector)
202 (numbered "pick" 2 mAX_DPH_SUM)
203 sel_tags <- mapM (externalFun dph_Selector)
204 (numbered "tagsSel" 2 mAX_DPH_SUM)
205 sel_els <- mapM mk_elements
206 [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
207 sum_tcs <- mapM (externalTyCon dph_Repr)
208 (numbered "Sum" 2 mAX_DPH_SUM)
210 let selTys = listArray (2, mAX_DPH_SUM) sel_tys
211 selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
212 selPicks = listArray (2, mAX_DPH_SUM) sel_picks
213 selTagss = listArray (2, mAX_DPH_SUM) sel_tags
214 selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
215 sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
217 voidVar <- externalVar dph_Repr (fsLit "void")
218 pvoidVar <- externalVar dph_Repr (fsLit "pvoid")
219 fromVoidVar <- externalVar dph_Repr (fsLit "fromVoid")
220 punitVar <- externalVar dph_Repr (fsLit "punit")
221 closureVar <- externalVar dph_Closure (fsLit "closure")
222 applyVar <- externalVar dph_Closure (fsLit "$:")
223 liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
224 liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply")
225 replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
226 emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
227 packByTagPDVar <- externalVar dph_PArray (fsLit "packByTagPD")
229 combines <- mapM (externalVar dph_PArray)
230 [mkFastString ("combine" ++ show i ++ "PD")
231 | i <- [2..mAX_DPH_COMBINE]]
232 let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
234 scalarClass <- externalClass dph_PArray (fsLit "Scalar")
235 scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
236 scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
237 scalar_zips <- mapM (externalVar dph_Scalar)
238 (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
239 let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
240 (scalar_map : scalar_zip2 : scalar_zips)
241 closures <- mapM (externalVar dph_Closure)
242 (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
243 let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
245 liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
250 , parrayTyCon = parrayTyCon
251 , parrayDataCon = parrayDataCon
252 , pdataTyCon = pdataTyCon
254 , paDataCon = paDataCon
255 , preprTyCon = preprTyCon
257 , prDataCon = prDataCon
258 , voidTyCon = voidTyCon
259 , wrapTyCon = wrapTyCon
261 , selReplicates = selReplicates
262 , selPicks = selPicks
263 , selTagss = selTagss
265 , sumTyCons = sumTyCons
266 , closureTyCon = closureTyCon
268 , pvoidVar = pvoidVar
269 , fromVoidVar = fromVoidVar
270 , punitVar = punitVar
271 , closureVar = closureVar
272 , applyVar = applyVar
273 , liftedClosureVar = liftedClosureVar
274 , liftedApplyVar = liftedApplyVar
275 , replicatePDVar = replicatePDVar
276 , emptyPDVar = emptyPDVar
277 , packByTagPDVar = packByTagPDVar
278 , combinePDVars = combinePDVars
279 , scalarClass = scalarClass
280 , scalarZips = scalarZips
281 , closureCtrFuns = closureCtrFuns
282 , liftingContext = liftingContext
286 dph_PArray = dph_PArray
287 , dph_Repr = dph_Repr
288 , dph_Closure = dph_Closure
289 , dph_Selector = dph_Selector
290 , dph_Scalar = dph_Scalar
294 load get_mod = dsLoadModule doc mod
296 mod = get_mod modules
297 doc = ppr mod <+> ptext (sLit "is a DPH module")
299 numbered :: String -> Int -> Int -> [FastString]
300 numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
302 mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
305 v <- externalVar dph_Selector
306 $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
307 return ((i,j), Var v)
310 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
311 initBuiltinVars (Builtins { dphModules = mods })
313 uvars <- zipWithM externalVar umods ufs
314 vvars <- zipWithM externalVar vmods vfs
315 cvars <- zipWithM externalVar cmods cfs
316 return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
317 ++ zip (map dataConWorkId cons) cvars
320 (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
322 (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
324 defaultDataConWorkers :: [DataCon]
325 defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
327 preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
328 preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
329 = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
331 mk_tup n mod name = (tupleCon Boxed n, mod, name)
334 -- | Mapping of prelude functions to vectorised versions.
335 -- Functions like filterP currently have a working but naive version in GHC.PArr
336 -- During vectorisation we replace these by calls to filterPA, which are
337 -- defined in dph-common Data.Array.Parallel.Lifted.Combinators
339 -- As renamer only sees the GHC.PArr functions, if you want to add a new function
340 -- to the vectoriser there has to be a definition for it in GHC.PArr, even though
341 -- it will never be used at runtime.
343 preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
344 preludeVars (Modules { dph_Combinators = dph_Combinators
345 , dph_PArray = dph_PArray
346 , dph_Prelude_Int = dph_Prelude_Int
347 , dph_Prelude_Word8 = dph_Prelude_Word8
348 , dph_Prelude_Double = dph_Prelude_Double
349 , dph_Prelude_Bool = dph_Prelude_Bool
350 , dph_Prelude_PArr = dph_Prelude_PArr
353 mk gHC_PARR (fsLit "mapP") dph_Combinators (fsLit "mapPA")
354 , mk gHC_PARR (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
355 , mk gHC_PARR (fsLit "zipP") dph_Combinators (fsLit "zipPA")
356 , mk gHC_PARR (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
357 , mk gHC_PARR (fsLit "filterP") dph_Combinators (fsLit "filterPA")
358 , mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
359 , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
360 , mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA")
361 , mk gHC_PARR (fsLit "sliceP") dph_Combinators (fsLit "slicePA")
362 , mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
363 , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
364 , mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA")
365 , mk gHC_PARR (fsLit "+:+") dph_Combinators (fsLit "appPA")
366 , mk gHC_PARR (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
368 , mk' dph_Prelude_Int "div" "divV"
369 , mk' dph_Prelude_Int "mod" "modV"
370 , mk' dph_Prelude_Int "sqrt" "sqrtV"
371 , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
372 -- , mk' dph_Prelude_Int "upToP" "upToPA"
374 ++ vars_Ord dph_Prelude_Int
375 ++ vars_Num dph_Prelude_Int
377 ++ vars_Ord dph_Prelude_Word8
378 ++ vars_Num dph_Prelude_Word8
380 [ mk' dph_Prelude_Word8 "div" "divV"
381 , mk' dph_Prelude_Word8 "mod" "modV"
382 , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
383 , mk' dph_Prelude_Word8 "toInt" "toIntV"
386 ++ vars_Ord dph_Prelude_Double
387 ++ vars_Num dph_Prelude_Double
388 ++ vars_Fractional dph_Prelude_Double
389 ++ vars_Floating dph_Prelude_Double
390 ++ vars_RealFrac dph_Prelude_Double
392 [ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
393 , mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
396 , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
397 , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
398 , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
399 , mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
403 mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
405 vars_Ord mod = [mk' mod "==" "eqV"
411 ,mk' mod "min" "minV"
412 ,mk' mod "max" "maxV"
413 ,mk' mod "minimumP" "minimumPA"
414 ,mk' mod "maximumP" "maximumPA"
415 ,mk' mod "minIndexP" "minIndexPA"
416 ,mk' mod "maxIndexP" "maxIndexPA"
419 vars_Num mod = [mk' mod "+" "plusV"
420 ,mk' mod "-" "minusV"
422 ,mk' mod "negate" "negateV"
423 ,mk' mod "abs" "absV"
424 ,mk' mod "sumP" "sumPA"
425 ,mk' mod "productP" "productPA"
428 vars_Fractional mod = [mk' mod "/" "divideV"
429 ,mk' mod "recip" "recipV"
432 vars_Floating mod = [mk' mod "pi" "pi"
433 ,mk' mod "exp" "expV"
434 ,mk' mod "sqrt" "sqrtV"
435 ,mk' mod "log" "logV"
436 ,mk' mod "sin" "sinV"
437 ,mk' mod "tan" "tanV"
438 ,mk' mod "cos" "cosV"
439 ,mk' mod "asin" "asinV"
440 ,mk' mod "atan" "atanV"
441 ,mk' mod "acos" "acosV"
442 ,mk' mod "sinh" "sinhV"
443 ,mk' mod "tanh" "tanhV"
444 ,mk' mod "cosh" "coshV"
445 ,mk' mod "asinh" "asinhV"
446 ,mk' mod "atanh" "atanhV"
447 ,mk' mod "acosh" "acoshV"
449 ,mk' mod "logBase" "logBaseV"
452 vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
453 ,mk' mod "truncate" "truncateV"
454 ,mk' mod "round" "roundV"
455 ,mk' mod "ceiling" "ceilingV"
456 ,mk' mod "floor" "floorV"
459 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
462 -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
463 dft_tcs <- defaultTyCons
464 return $ (tyConName funTyCon, closureTyCon bi)
465 : (parrTyConName, parrayTyCon bi)
468 : (tyConName $ parrayTyCon bi, parrayTyCon bi)
470 : [(tyConName tc, tc) | tc <- dft_tcs]
472 defaultTyCons :: DsM [TyCon]
475 word8 <- dsLookupTyCon word8TyConName
476 return [intTyCon, boolTyCon, doubleTyCon, word8]
478 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
479 initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
481 defaultDataCons :: [DataCon]
482 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
484 initBuiltinPAs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
485 initBuiltinPAs (Builtins { dphModules = mods }) insts
486 = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PA"))
488 initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
489 initBuiltinPRs (Builtins { dphModules = mods }) insts
490 = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PR"))
492 initBuiltinDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
493 initBuiltinDicts insts cls = map find $ classInstances insts cls
495 find i | [Just tc] <- instanceRoughTcs i = (tc, instanceDFunId i)
496 | otherwise = pprPanic "Invalid DPH instance" (ppr i)
498 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
499 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
501 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
502 builtinBoxedTyCons _ =
503 [(tyConName intPrimTyCon, intTyCon)]
506 initBuiltinScalars :: Builtins -> DsM [Var]
507 initBuiltinScalars bi
508 = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
511 preludeScalars :: Modules -> [(Module, FastString)]
512 preludeScalars (Modules { dph_Prelude_Int = dph_Prelude_Int
513 , dph_Prelude_Word8 = dph_Prelude_Word8
514 , dph_Prelude_Double = dph_Prelude_Double
517 mk dph_Prelude_Int "div"
518 , mk dph_Prelude_Int "mod"
519 , mk dph_Prelude_Int "sqrt"
521 ++ scalars_Ord dph_Prelude_Int
522 ++ scalars_Num dph_Prelude_Int
524 ++ scalars_Ord dph_Prelude_Word8
525 ++ scalars_Num dph_Prelude_Word8
527 [ mk dph_Prelude_Word8 "div"
528 , mk dph_Prelude_Word8 "mod"
529 , mk dph_Prelude_Word8 "fromInt"
530 , mk dph_Prelude_Word8 "toInt"
533 ++ scalars_Ord dph_Prelude_Double
534 ++ scalars_Num dph_Prelude_Double
535 ++ scalars_Fractional dph_Prelude_Double
536 ++ scalars_Floating dph_Prelude_Double
537 ++ scalars_RealFrac dph_Prelude_Double
539 mk mod s = (mod, fsLit s)
541 scalars_Ord mod = [mk mod "=="
551 scalars_Num mod = [mk mod "+"
558 scalars_Fractional mod = [mk mod "/"
562 scalars_Floating mod = [mk mod "pi"
582 scalars_RealFrac mod = [mk mod "fromInt"
590 externalVar :: Module -> FastString -> DsM Var
592 = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
594 externalFun :: Module -> FastString -> DsM CoreExpr
597 var <- externalVar mod fs
600 externalTyCon :: Module -> FastString -> DsM TyCon
602 = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
604 externalClassTyCon :: Module -> FastString -> DsM TyCon
605 externalClassTyCon mod fs = liftM classTyCon (externalClass mod fs)
607 externalType :: Module -> FastString -> DsM Type
610 tycon <- externalTyCon mod fs
611 return $ mkTyConApp tycon []
613 externalClass :: Module -> FastString -> DsM Class
615 = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs)
617 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
618 primMethod tycon method (Builtins { dphModules = mods })
619 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
621 $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
622 (mkVarOcc $ method ++ suffix)
624 | otherwise = return Nothing
626 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
627 primPArray tycon (Builtins { dphModules = mods })
628 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
630 $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
631 (mkTcOcc $ "PArray" ++ suffix)
633 | otherwise = return Nothing
635 prim_ty_cons :: NameEnv String
636 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
638 mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)