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
165 combinePDVar :: Int -> Builtins -> Var
166 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
168 scalarZip :: Int -> Builtins -> Var
169 scalarZip = indexBuiltin "scalarZip" scalarZips
171 closureCtrFun :: Int -> Builtins -> Var
172 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
174 initBuiltins :: PackageId -> DsM Builtins
177 parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray")
178 let [parrayDataCon] = tyConDataCons parrayTyCon
179 pdataTyCon <- externalTyCon dph_PArray (fsLit "PData")
180 paTyCon <- externalTyCon dph_PArray (fsLit "PA")
181 let [paDataCon] = tyConDataCons paTyCon
182 preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
183 prTyCon <- externalTyCon dph_PArray (fsLit "PR")
184 let [prDataCon] = tyConDataCons prTyCon
185 closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
187 voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
188 wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
189 sel_tys <- mapM (externalType dph_Selector)
190 (numbered "Sel" 2 mAX_DPH_SUM)
191 sel_replicates <- mapM (externalFun dph_Selector)
192 (numbered "replicate" 2 mAX_DPH_SUM)
193 sel_picks <- mapM (externalFun dph_Selector)
194 (numbered "pick" 2 mAX_DPH_SUM)
195 sel_els <- mapM mk_elements
196 [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
197 sum_tcs <- mapM (externalTyCon dph_Repr)
198 (numbered "Sum" 2 mAX_DPH_SUM)
200 let selTys = listArray (2, mAX_DPH_SUM) sel_tys
201 selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
202 selPicks = listArray (2, mAX_DPH_SUM) sel_picks
203 selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
204 sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
206 voidVar <- externalVar dph_Repr (fsLit "void")
207 pvoidVar <- externalVar dph_Repr (fsLit "pvoid")
208 punitVar <- externalVar dph_Repr (fsLit "punit")
209 mkPRVar <- externalVar dph_PArray (fsLit "mkPR")
210 closureVar <- externalVar dph_Closure (fsLit "closure")
211 applyVar <- externalVar dph_Closure (fsLit "$:")
212 liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
213 liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply")
214 replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
215 emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
216 packPDVar <- externalVar dph_PArray (fsLit "packPD")
218 combines <- mapM (externalVar dph_PArray)
219 [mkFastString ("combine" ++ show i ++ "PD")
220 | i <- [2..mAX_DPH_COMBINE]]
221 let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
223 scalarClass <- externalClass dph_Scalar (fsLit "Scalar")
224 scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
225 scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
226 scalar_zips <- mapM (externalVar dph_Scalar)
227 (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
228 let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
229 (scalar_map : scalar_zip2 : scalar_zips)
230 closures <- mapM (externalVar dph_Closure)
231 (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
232 let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
234 liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
239 , parrayTyCon = parrayTyCon
240 , parrayDataCon = parrayDataCon
241 , pdataTyCon = pdataTyCon
243 , paDataCon = paDataCon
244 , preprTyCon = preprTyCon
246 , prDataCon = prDataCon
247 , voidTyCon = voidTyCon
248 , wrapTyCon = wrapTyCon
250 , selReplicates = selReplicates
251 , selPicks = selPicks
253 , sumTyCons = sumTyCons
254 , closureTyCon = closureTyCon
256 , pvoidVar = pvoidVar
257 , punitVar = punitVar
259 , closureVar = closureVar
260 , applyVar = applyVar
261 , liftedClosureVar = liftedClosureVar
262 , liftedApplyVar = liftedApplyVar
263 , replicatePDVar = replicatePDVar
264 , emptyPDVar = emptyPDVar
265 , packPDVar = packPDVar
266 , combinePDVars = combinePDVars
267 , scalarClass = scalarClass
268 , scalarZips = scalarZips
269 , closureCtrFuns = closureCtrFuns
270 , liftingContext = liftingContext
274 dph_PArray = dph_PArray
275 , dph_Repr = dph_Repr
276 , dph_Closure = dph_Closure
277 , dph_Selector = dph_Selector
278 , dph_Unboxed = dph_Unboxed
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)