2 Builtins(..), sumTyCon, prodTyCon, prodDataCon,
3 selTy, selReplicate, selPick, selElements,
4 combinePDVar, scalarZip, closureCtrFun,
5 initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
6 initBuiltinPAs, initBuiltinPRs,
7 initBuiltinBoxedTyCons, initBuiltinScalars,
13 import IfaceEnv ( lookupOrig )
16 import DataCon ( DataCon, dataConName, dataConWorkId )
17 import TyCon ( TyCon, tyConName, tyConDataCons )
18 import Class ( Class )
19 import CoreSyn ( CoreExpr, Expr(..) )
21 import Id ( mkSysLocal )
22 import Name ( Name, getOccString )
26 import TypeRep ( funTyCon )
27 import Type ( Type, mkTyConApp )
29 import TysWiredIn ( unitTyCon, unitDataCon,
31 intTyCon, intTyConName,
32 doubleTyCon, doubleTyConName,
33 boolTyCon, boolTyConName, trueDataCon, falseDataCon,
35 import PrelNames ( word8TyConName, gHC_PARR )
36 import BasicTypes ( Boxity(..) )
42 import Control.Monad ( liftM, zipWithM )
43 import Data.List ( unzip4 )
51 mAX_DPH_COMBINE :: Int
54 mAX_DPH_SCALAR_ARGS :: Int
55 mAX_DPH_SCALAR_ARGS = 3
57 data Modules = Modules {
60 , dph_Closure :: Module
61 , dph_Unboxed :: Module
62 , dph_Instances :: Module
63 , dph_Combinators :: Module
64 , dph_Scalar :: Module
65 , dph_Selector :: Module
66 , dph_Prelude_PArr :: Module
67 , dph_Prelude_Int :: Module
68 , dph_Prelude_Word8 :: Module
69 , dph_Prelude_Double :: Module
70 , dph_Prelude_Bool :: Module
71 , dph_Prelude_Tuple :: Module
74 dph_Modules :: PackageId -> Modules
75 dph_Modules pkg = Modules {
76 dph_PArray = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
77 , dph_Repr = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
78 , dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
79 , dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
80 , dph_Instances = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
81 , dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
82 , dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
83 , dph_Selector = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
85 , dph_Prelude_PArr = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
86 , dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
87 , dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
88 , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
89 , dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
90 , dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
93 mk = mkModule pkg . mkModuleNameFS
96 data Builtins = Builtins {
98 , parrayTyCon :: TyCon
99 , parrayDataCon :: DataCon
100 , pdataTyCon :: TyCon
102 , paDataCon :: DataCon
103 , preprTyCon :: TyCon
105 , prDataCon :: DataCon
108 , selTys :: Array Int Type
109 , selReplicates :: Array Int CoreExpr
110 , selPicks :: Array Int CoreExpr
111 , selEls :: Array (Int, Int) CoreExpr
112 , sumTyCons :: Array Int TyCon
113 , closureTyCon :: TyCon
120 , liftedClosureVar :: Var
121 , liftedApplyVar :: Var
122 , replicatePDVar :: Var
125 , combinePDVars :: Array Int Var
126 , scalarClass :: Class
127 , scalarZips :: Array Int Var
128 , closureCtrFuns :: Array Int Var
129 , liftingContext :: Var
132 indexBuiltin :: (Ix i, Outputable i) => String -> (Builtins -> Array i a)
133 -> i -> Builtins -> a
134 indexBuiltin fn f i bi
135 | inRange (bounds xs) i = xs ! i
136 | otherwise = pprPanic fn (ppr i)
140 selTy :: Int -> Builtins -> Type
141 selTy = indexBuiltin "selTy" selTys
143 selReplicate :: Int -> Builtins -> CoreExpr
144 selReplicate = indexBuiltin "selReplicate" selReplicates
146 selPick :: Int -> Builtins -> CoreExpr
147 selPick = indexBuiltin "selPick" selPicks
149 selElements :: Int -> Int -> Builtins -> CoreExpr
150 selElements i j = indexBuiltin "selElements" selEls (i,j)
152 sumTyCon :: Int -> Builtins -> TyCon
153 sumTyCon = indexBuiltin "sumTyCon" sumTyCons
155 prodTyCon :: Int -> Builtins -> TyCon
157 | n == 1 = wrapTyCon bi
158 | n >= 0 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
159 | otherwise = pprPanic "prodTyCon" (ppr n)
161 prodDataCon :: Int -> Builtins -> DataCon
162 prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
164 _ -> pprPanic "prodDataCon" (ppr n)
166 combinePDVar :: Int -> Builtins -> Var
167 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
169 scalarZip :: Int -> Builtins -> Var
170 scalarZip = indexBuiltin "scalarZip" scalarZips
172 closureCtrFun :: Int -> Builtins -> Var
173 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
175 initBuiltins :: PackageId -> DsM Builtins
178 parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray")
179 let [parrayDataCon] = tyConDataCons parrayTyCon
180 pdataTyCon <- externalTyCon dph_PArray (fsLit "PData")
181 paTyCon <- externalTyCon dph_PArray (fsLit "PA")
182 let [paDataCon] = tyConDataCons paTyCon
183 preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
184 prTyCon <- externalTyCon dph_PArray (fsLit "PR")
185 let [prDataCon] = tyConDataCons prTyCon
186 closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
188 voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
189 wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
190 sel_tys <- mapM (externalType dph_Selector)
191 (numbered "Sel" 2 mAX_DPH_SUM)
192 sel_replicates <- mapM (externalFun dph_Selector)
193 (numbered "replicate" 2 mAX_DPH_SUM)
194 sel_picks <- mapM (externalFun dph_Selector)
195 (numbered "pick" 2 mAX_DPH_SUM)
196 sel_els <- mapM mk_elements
197 [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
198 sum_tcs <- mapM (externalTyCon dph_Repr)
199 (numbered "Sum" 2 mAX_DPH_SUM)
201 let selTys = listArray (2, mAX_DPH_SUM) sel_tys
202 selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
203 selPicks = listArray (2, mAX_DPH_SUM) sel_picks
204 selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
205 sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
207 voidVar <- externalVar dph_Repr (fsLit "void")
208 pvoidVar <- externalVar dph_Repr (fsLit "pvoid")
209 punitVar <- externalVar dph_Repr (fsLit "punit")
210 mkPRVar <- externalVar dph_PArray (fsLit "mkPR")
211 closureVar <- externalVar dph_Closure (fsLit "closure")
212 applyVar <- externalVar dph_Closure (fsLit "$:")
213 liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
214 liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply")
215 replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
216 emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
217 packPDVar <- externalVar dph_PArray (fsLit "packPD")
219 combines <- mapM (externalVar dph_PArray)
220 [mkFastString ("combine" ++ show i ++ "PD")
221 | i <- [2..mAX_DPH_COMBINE]]
222 let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
224 scalarClass <- externalClass dph_Scalar (fsLit "Scalar")
225 scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
226 scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
227 scalar_zips <- mapM (externalVar dph_Scalar)
228 (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
229 let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
230 (scalar_map : scalar_zip2 : scalar_zips)
231 closures <- mapM (externalVar dph_Closure)
232 (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
233 let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
235 liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
240 , parrayTyCon = parrayTyCon
241 , parrayDataCon = parrayDataCon
242 , pdataTyCon = pdataTyCon
244 , paDataCon = paDataCon
245 , preprTyCon = preprTyCon
247 , prDataCon = prDataCon
248 , voidTyCon = voidTyCon
249 , wrapTyCon = wrapTyCon
251 , selReplicates = selReplicates
252 , selPicks = selPicks
254 , sumTyCons = sumTyCons
255 , closureTyCon = closureTyCon
257 , pvoidVar = pvoidVar
258 , punitVar = punitVar
260 , closureVar = closureVar
261 , applyVar = applyVar
262 , liftedClosureVar = liftedClosureVar
263 , liftedApplyVar = liftedApplyVar
264 , replicatePDVar = replicatePDVar
265 , emptyPDVar = emptyPDVar
266 , packPDVar = packPDVar
267 , combinePDVars = combinePDVars
268 , scalarClass = scalarClass
269 , scalarZips = scalarZips
270 , closureCtrFuns = closureCtrFuns
271 , liftingContext = liftingContext
275 dph_PArray = dph_PArray
276 , dph_Repr = dph_Repr
277 , dph_Closure = dph_Closure
278 , dph_Selector = dph_Selector
279 , dph_Scalar = dph_Scalar
283 numbered :: String -> Int -> Int -> [FastString]
284 numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
286 mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
289 v <- externalVar dph_Selector
290 $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
291 return ((i,j), Var v)
294 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
295 initBuiltinVars (Builtins { dphModules = mods })
297 uvars <- zipWithM externalVar umods ufs
298 vvars <- zipWithM externalVar vmods vfs
299 cvars <- zipWithM externalVar cmods cfs
300 return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
301 ++ zip (map dataConWorkId cons) cvars
304 (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
306 (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
308 defaultDataConWorkers :: [DataCon]
309 defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
311 preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
312 preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
313 = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
315 mk_tup n mod name = (tupleCon Boxed n, mod, name)
317 preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
318 preludeVars (Modules { dph_Combinators = dph_Combinators
319 , dph_PArray = dph_PArray
320 , dph_Prelude_Int = dph_Prelude_Int
321 , dph_Prelude_Word8 = dph_Prelude_Word8
322 , dph_Prelude_Double = dph_Prelude_Double
323 , dph_Prelude_Bool = dph_Prelude_Bool
324 , dph_Prelude_PArr = dph_Prelude_PArr
327 mk gHC_PARR (fsLit "mapP") dph_Combinators (fsLit "mapPA")
328 , mk gHC_PARR (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
329 , mk gHC_PARR (fsLit "zipP") dph_Combinators (fsLit "zipPA")
330 , mk gHC_PARR (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
331 , mk gHC_PARR (fsLit "filterP") dph_Combinators (fsLit "filterPA")
332 , mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
333 , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
334 , mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA")
335 , mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
336 , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
337 , mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA")
338 , mk gHC_PARR (fsLit "+:+") dph_Combinators (fsLit "appPA")
339 , mk gHC_PARR (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
341 , mk' dph_Prelude_Int "div" "divV"
342 , mk' dph_Prelude_Int "mod" "modV"
343 , mk' dph_Prelude_Int "sqrt" "sqrtV"
344 , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
345 -- , mk' dph_Prelude_Int "upToP" "upToPA"
347 ++ vars_Ord dph_Prelude_Int
348 ++ vars_Num dph_Prelude_Int
350 ++ vars_Ord dph_Prelude_Word8
351 ++ vars_Num dph_Prelude_Word8
353 [ mk' dph_Prelude_Word8 "div" "divV"
354 , mk' dph_Prelude_Word8 "mod" "modV"
355 , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
356 , mk' dph_Prelude_Word8 "toInt" "toIntV"
359 ++ vars_Ord dph_Prelude_Double
360 ++ vars_Num dph_Prelude_Double
361 ++ vars_Fractional dph_Prelude_Double
362 ++ vars_Floating dph_Prelude_Double
363 ++ vars_RealFrac dph_Prelude_Double
365 [ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
366 , mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
369 , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
370 , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
371 , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
372 , mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
376 mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
378 vars_Ord mod = [mk' mod "==" "eqV"
384 ,mk' mod "min" "minV"
385 ,mk' mod "max" "maxV"
386 ,mk' mod "minimumP" "minimumPA"
387 ,mk' mod "maximumP" "maximumPA"
388 ,mk' mod "minIndexP" "minIndexPA"
389 ,mk' mod "maxIndexP" "maxIndexPA"
392 vars_Num mod = [mk' mod "+" "plusV"
393 ,mk' mod "-" "minusV"
395 ,mk' mod "negate" "negateV"
396 ,mk' mod "abs" "absV"
397 ,mk' mod "sumP" "sumPA"
398 ,mk' mod "productP" "productPA"
401 vars_Fractional mod = [mk' mod "/" "divideV"
402 ,mk' mod "recip" "recipV"
405 vars_Floating mod = [mk' mod "pi" "pi"
406 ,mk' mod "exp" "expV"
407 ,mk' mod "sqrt" "sqrtV"
408 ,mk' mod "log" "logV"
409 ,mk' mod "sin" "sinV"
410 ,mk' mod "tan" "tanV"
411 ,mk' mod "cos" "cosV"
412 ,mk' mod "asin" "asinV"
413 ,mk' mod "atan" "atanV"
414 ,mk' mod "acos" "acosV"
415 ,mk' mod "sinh" "sinhV"
416 ,mk' mod "tanh" "tanhV"
417 ,mk' mod "cosh" "coshV"
418 ,mk' mod "asinh" "asinhV"
419 ,mk' mod "atanh" "atanhV"
420 ,mk' mod "acosh" "acoshV"
422 ,mk' mod "logBase" "logBaseV"
425 vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
426 ,mk' mod "truncate" "truncateV"
427 ,mk' mod "round" "roundV"
428 ,mk' mod "ceiling" "ceilingV"
429 ,mk' mod "floor" "floorV"
432 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
435 -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
436 dft_tcs <- defaultTyCons
437 return $ (tyConName funTyCon, closureTyCon bi)
438 : (parrTyConName, parrayTyCon bi)
441 : (tyConName $ parrayTyCon bi, parrayTyCon bi)
443 : [(tyConName tc, tc) | tc <- dft_tcs]
445 defaultTyCons :: DsM [TyCon]
448 word8 <- dsLookupTyCon word8TyConName
449 return [intTyCon, boolTyCon, doubleTyCon, word8]
451 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
452 initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
454 defaultDataCons :: [DataCon]
455 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
457 initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
460 dicts <- zipWithM externalVar mods fss
461 return $ zip tcs dicts
463 (tcs, mods, fss) = unzip3 ps
465 initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
466 initBuiltinPAs = initBuiltinDicts . builtinPAs
468 builtinPAs :: Builtins -> [(Name, Module, FastString)]
469 builtinPAs bi@(Builtins { dphModules = mods })
471 mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "dPA_Clo")
472 , mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "dPA_Void")
473 , mk (tyConName $ parrayTyCon bi) (dph_Instances mods) (fsLit "dPA_PArray")
474 , mk unitTyConName (dph_Instances mods) (fsLit "dPA_Unit")
476 , mk intTyConName (dph_Instances mods) (fsLit "dPA_Int")
477 , mk word8TyConName (dph_Instances mods) (fsLit "dPA_Word8")
478 , mk doubleTyConName (dph_Instances mods) (fsLit "dPA_Double")
479 , mk boolTyConName (dph_Instances mods) (fsLit "dPA_Bool")
483 mk name mod fs = (name, mod, fs)
485 tups = map mk_tup [2..mAX_DPH_PROD]
486 mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
488 (mkFastString $ "dPA_" ++ show n)
490 initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
491 initBuiltinPRs = initBuiltinDicts . builtinPRs
493 builtinPRs :: Builtins -> [(Name, Module, FastString)]
494 builtinPRs bi@(Builtins { dphModules = mods }) =
496 mk (tyConName unitTyCon) (dph_Repr mods) (fsLit "dPR_Unit")
497 , mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "dPR_Void")
498 , mk (tyConName $ wrapTyCon bi) (dph_Repr mods) (fsLit "dPR_Wrap")
499 , mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "dPR_Clo")
502 , mk intTyConName (dph_Instances mods) (fsLit "dPR_Int")
503 , mk word8TyConName (dph_Instances mods) (fsLit "dPR_Word8")
504 , mk doubleTyConName (dph_Instances mods) (fsLit "dPR_Double")
507 ++ map mk_sum [2..mAX_DPH_SUM]
508 ++ map mk_prod [2..mAX_DPH_PROD]
510 mk name mod fs = (name, mod, fs)
512 mk_sum n = (tyConName $ sumTyCon n bi, dph_Repr mods,
513 mkFastString ("dPR_Sum" ++ show n))
515 mk_prod n = (tyConName $ prodTyCon n bi, dph_Repr mods,
516 mkFastString ("dPR_" ++ show n))
518 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
519 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
521 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
522 builtinBoxedTyCons _ =
523 [(tyConName intPrimTyCon, intTyCon)]
526 initBuiltinScalars :: Builtins -> DsM [Var]
527 initBuiltinScalars bi
528 = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
531 preludeScalars :: Modules -> [(Module, FastString)]
532 preludeScalars (Modules { dph_Prelude_Int = dph_Prelude_Int
533 , dph_Prelude_Word8 = dph_Prelude_Word8
534 , dph_Prelude_Double = dph_Prelude_Double
537 mk dph_Prelude_Int "div"
538 , mk dph_Prelude_Int "mod"
539 , mk dph_Prelude_Int "sqrt"
541 ++ scalars_Ord dph_Prelude_Int
542 ++ scalars_Num dph_Prelude_Int
544 ++ scalars_Ord dph_Prelude_Word8
545 ++ scalars_Num dph_Prelude_Word8
547 [ mk dph_Prelude_Word8 "div"
548 , mk dph_Prelude_Word8 "mod"
549 , mk dph_Prelude_Word8 "fromInt"
550 , mk dph_Prelude_Word8 "toInt"
553 ++ scalars_Ord dph_Prelude_Double
554 ++ scalars_Num dph_Prelude_Double
555 ++ scalars_Fractional dph_Prelude_Double
556 ++ scalars_Floating dph_Prelude_Double
557 ++ scalars_RealFrac dph_Prelude_Double
559 mk mod s = (mod, fsLit s)
561 scalars_Ord mod = [mk mod "=="
571 scalars_Num mod = [mk mod "+"
578 scalars_Fractional mod = [mk mod "/"
582 scalars_Floating mod = [mk mod "pi"
602 scalars_RealFrac mod = [mk mod "fromInt"
610 externalVar :: Module -> FastString -> DsM Var
612 = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
614 externalFun :: Module -> FastString -> DsM CoreExpr
617 var <- externalVar mod fs
620 externalTyCon :: Module -> FastString -> DsM TyCon
622 = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
624 externalType :: Module -> FastString -> DsM Type
627 tycon <- externalTyCon mod fs
628 return $ mkTyConApp tycon []
630 externalClass :: Module -> FastString -> DsM Class
632 = dsLookupClass =<< lookupOrig mod (mkTcOccFS fs)
634 unitTyConName :: Name
635 unitTyConName = tyConName unitTyCon
638 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
639 primMethod tycon method (Builtins { dphModules = mods })
640 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
642 $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
643 (mkVarOcc $ method ++ suffix)
645 | otherwise = return Nothing
647 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
648 primPArray tycon (Builtins { dphModules = mods })
649 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
651 $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
652 (mkTcOcc $ "PArray" ++ suffix)
654 | otherwise = return Nothing
656 prim_ty_cons :: NameEnv String
657 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
659 mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)