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, classTyCon )
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 >= 2 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
158 | otherwise = pprPanic "prodTyCon" (ppr n)
160 prodDataCon :: Int -> Builtins -> DataCon
161 prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
163 _ -> pprPanic "prodDataCon" (ppr n)
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 <- externalClassTyCon dph_PArray (fsLit "PA")
181 let [paDataCon] = tyConDataCons paTyCon
182 preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
183 prTyCon <- externalClassTyCon 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 fromVoidVar <- externalVar dph_Repr (fsLit "fromVoid")
209 punitVar <- externalVar dph_Repr (fsLit "punit")
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 , fromVoidVar = fromVoidVar
258 , 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_Scalar = dph_Scalar
282 numbered :: String -> Int -> Int -> [FastString]
283 numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
285 mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
288 v <- externalVar dph_Selector
289 $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
290 return ((i,j), Var v)
293 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
294 initBuiltinVars (Builtins { dphModules = mods })
296 uvars <- zipWithM externalVar umods ufs
297 vvars <- zipWithM externalVar vmods vfs
298 cvars <- zipWithM externalVar cmods cfs
299 return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
300 ++ zip (map dataConWorkId cons) cvars
303 (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
305 (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
307 defaultDataConWorkers :: [DataCon]
308 defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
310 preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
311 preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
312 = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
314 mk_tup n mod name = (tupleCon Boxed n, mod, name)
316 preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
317 preludeVars (Modules { dph_Combinators = dph_Combinators
318 , dph_PArray = dph_PArray
319 , dph_Prelude_Int = dph_Prelude_Int
320 , dph_Prelude_Word8 = dph_Prelude_Word8
321 , dph_Prelude_Double = dph_Prelude_Double
322 , dph_Prelude_Bool = dph_Prelude_Bool
323 , dph_Prelude_PArr = dph_Prelude_PArr
326 mk gHC_PARR (fsLit "mapP") dph_Combinators (fsLit "mapPA")
327 , mk gHC_PARR (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
328 , mk gHC_PARR (fsLit "zipP") dph_Combinators (fsLit "zipPA")
329 , mk gHC_PARR (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
330 , mk gHC_PARR (fsLit "filterP") dph_Combinators (fsLit "filterPA")
331 , mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
332 , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
333 , mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA")
334 , mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
335 , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
336 , mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA")
337 , mk gHC_PARR (fsLit "+:+") dph_Combinators (fsLit "appPA")
338 , mk gHC_PARR (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
340 , mk' dph_Prelude_Int "div" "divV"
341 , mk' dph_Prelude_Int "mod" "modV"
342 , mk' dph_Prelude_Int "sqrt" "sqrtV"
343 , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
344 -- , mk' dph_Prelude_Int "upToP" "upToPA"
346 ++ vars_Ord dph_Prelude_Int
347 ++ vars_Num dph_Prelude_Int
349 ++ vars_Ord dph_Prelude_Word8
350 ++ vars_Num dph_Prelude_Word8
352 [ mk' dph_Prelude_Word8 "div" "divV"
353 , mk' dph_Prelude_Word8 "mod" "modV"
354 , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
355 , mk' dph_Prelude_Word8 "toInt" "toIntV"
358 ++ vars_Ord dph_Prelude_Double
359 ++ vars_Num dph_Prelude_Double
360 ++ vars_Fractional dph_Prelude_Double
361 ++ vars_Floating dph_Prelude_Double
362 ++ vars_RealFrac dph_Prelude_Double
364 [ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
365 , mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
368 , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
369 , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
370 , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
371 , mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
375 mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
377 vars_Ord mod = [mk' mod "==" "eqV"
383 ,mk' mod "min" "minV"
384 ,mk' mod "max" "maxV"
385 ,mk' mod "minimumP" "minimumPA"
386 ,mk' mod "maximumP" "maximumPA"
387 ,mk' mod "minIndexP" "minIndexPA"
388 ,mk' mod "maxIndexP" "maxIndexPA"
391 vars_Num mod = [mk' mod "+" "plusV"
392 ,mk' mod "-" "minusV"
394 ,mk' mod "negate" "negateV"
395 ,mk' mod "abs" "absV"
396 ,mk' mod "sumP" "sumPA"
397 ,mk' mod "productP" "productPA"
400 vars_Fractional mod = [mk' mod "/" "divideV"
401 ,mk' mod "recip" "recipV"
404 vars_Floating mod = [mk' mod "pi" "pi"
405 ,mk' mod "exp" "expV"
406 ,mk' mod "sqrt" "sqrtV"
407 ,mk' mod "log" "logV"
408 ,mk' mod "sin" "sinV"
409 ,mk' mod "tan" "tanV"
410 ,mk' mod "cos" "cosV"
411 ,mk' mod "asin" "asinV"
412 ,mk' mod "atan" "atanV"
413 ,mk' mod "acos" "acosV"
414 ,mk' mod "sinh" "sinhV"
415 ,mk' mod "tanh" "tanhV"
416 ,mk' mod "cosh" "coshV"
417 ,mk' mod "asinh" "asinhV"
418 ,mk' mod "atanh" "atanhV"
419 ,mk' mod "acosh" "acoshV"
421 ,mk' mod "logBase" "logBaseV"
424 vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
425 ,mk' mod "truncate" "truncateV"
426 ,mk' mod "round" "roundV"
427 ,mk' mod "ceiling" "ceilingV"
428 ,mk' mod "floor" "floorV"
431 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
434 -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
435 dft_tcs <- defaultTyCons
436 return $ (tyConName funTyCon, closureTyCon bi)
437 : (parrTyConName, parrayTyCon bi)
440 : (tyConName $ parrayTyCon bi, parrayTyCon bi)
442 : [(tyConName tc, tc) | tc <- dft_tcs]
444 defaultTyCons :: DsM [TyCon]
447 word8 <- dsLookupTyCon word8TyConName
448 return [intTyCon, boolTyCon, doubleTyCon, word8]
450 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
451 initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
453 defaultDataCons :: [DataCon]
454 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
456 initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
459 dicts <- zipWithM externalVar mods fss
460 return $ zip tcs dicts
462 (tcs, mods, fss) = unzip3 ps
464 initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
465 initBuiltinPAs = initBuiltinDicts . builtinPAs
467 builtinPAs :: Builtins -> [(Name, Module, FastString)]
468 builtinPAs bi@(Builtins { dphModules = mods })
470 mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "$fPA:->")
471 , mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "$fPAVoid")
472 , mk (tyConName $ parrayTyCon bi) (dph_Instances mods) (fsLit "$fPAPArray")
473 , mk unitTyConName (dph_Instances mods) (fsLit "$fPA()")
475 , mk intTyConName (dph_Instances mods) (fsLit "$fPAInt")
476 , mk word8TyConName (dph_Instances mods) (fsLit "$fPAWord8")
477 , mk doubleTyConName (dph_Instances mods) (fsLit "$fPADouble")
478 , mk boolTyConName (dph_Instances mods) (fsLit "$fPABool")
482 mk name mod fs = (name, mod, fs)
484 tups = map mk_tup [2..mAX_DPH_PROD]
485 mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
487 (mkFastString $ "$fPA(" ++ replicate (n-1) ',' ++ ")")
489 initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
490 initBuiltinPRs = initBuiltinDicts . builtinPRs
492 builtinPRs :: Builtins -> [(Name, Module, FastString)]
493 builtinPRs bi@(Builtins { dphModules = mods }) =
495 mk (tyConName unitTyCon) (dph_Repr mods) (fsLit "$fPR()")
496 , mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "$fPRVoid")
497 , mk (tyConName $ wrapTyCon bi) (dph_Repr mods) (fsLit "$fPRWrap")
498 , mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "$fPR:->")
501 , mk intTyConName (dph_Instances mods) (fsLit "$fPRInt")
502 , mk word8TyConName (dph_Instances mods) (fsLit "$fPRWord8")
503 , mk doubleTyConName (dph_Instances mods) (fsLit "$fPRDouble")
506 ++ map mk_sum [2..mAX_DPH_SUM]
507 ++ map mk_prod [2..mAX_DPH_PROD]
509 mk name mod fs = (name, mod, fs)
511 mk_sum n = (tyConName $ sumTyCon n bi, dph_Repr mods,
512 mkFastString ("$fPRSum" ++ show n))
514 mk_prod n = (tyConName $ prodTyCon n bi, dph_Repr mods,
515 mkFastString ("$fPR(" ++ replicate (n-1) ',' ++ ")"))
517 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
518 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
520 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
521 builtinBoxedTyCons _ =
522 [(tyConName intPrimTyCon, intTyCon)]
525 initBuiltinScalars :: Builtins -> DsM [Var]
526 initBuiltinScalars bi
527 = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
530 preludeScalars :: Modules -> [(Module, FastString)]
531 preludeScalars (Modules { dph_Prelude_Int = dph_Prelude_Int
532 , dph_Prelude_Word8 = dph_Prelude_Word8
533 , dph_Prelude_Double = dph_Prelude_Double
536 mk dph_Prelude_Int "div"
537 , mk dph_Prelude_Int "mod"
538 , mk dph_Prelude_Int "sqrt"
540 ++ scalars_Ord dph_Prelude_Int
541 ++ scalars_Num dph_Prelude_Int
543 ++ scalars_Ord dph_Prelude_Word8
544 ++ scalars_Num dph_Prelude_Word8
546 [ mk dph_Prelude_Word8 "div"
547 , mk dph_Prelude_Word8 "mod"
548 , mk dph_Prelude_Word8 "fromInt"
549 , mk dph_Prelude_Word8 "toInt"
552 ++ scalars_Ord dph_Prelude_Double
553 ++ scalars_Num dph_Prelude_Double
554 ++ scalars_Fractional dph_Prelude_Double
555 ++ scalars_Floating dph_Prelude_Double
556 ++ scalars_RealFrac dph_Prelude_Double
558 mk mod s = (mod, fsLit s)
560 scalars_Ord mod = [mk mod "=="
570 scalars_Num mod = [mk mod "+"
577 scalars_Fractional mod = [mk mod "/"
581 scalars_Floating mod = [mk mod "pi"
601 scalars_RealFrac mod = [mk mod "fromInt"
609 externalVar :: Module -> FastString -> DsM Var
611 = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
613 externalFun :: Module -> FastString -> DsM CoreExpr
616 var <- externalVar mod fs
619 externalTyCon :: Module -> FastString -> DsM TyCon
621 = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
623 externalClassTyCon :: Module -> FastString -> DsM TyCon
624 externalClassTyCon mod fs
626 $ dsLookupClass =<< lookupOrig mod (mkClsOccFS fs)
628 externalType :: Module -> FastString -> DsM Type
631 tycon <- externalTyCon mod fs
632 return $ mkTyConApp tycon []
634 externalClass :: Module -> FastString -> DsM Class
636 = dsLookupClass =<< lookupOrig mod (mkTcOccFS fs)
638 unitTyConName :: Name
639 unitTyConName = tyConName unitTyCon
642 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
643 primMethod tycon method (Builtins { dphModules = mods })
644 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
646 $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
647 (mkVarOcc $ method ++ suffix)
649 | otherwise = return Nothing
651 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
652 primPArray tycon (Builtins { dphModules = mods })
653 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
655 $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
656 (mkTcOcc $ "PArray" ++ suffix)
658 | otherwise = return Nothing
660 prim_ty_cons :: NameEnv String
661 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
663 mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)