2 -- | The vectoriser rewrites user code to use builtin types and functions exported by the DPH library.
3 -- We track the names of those things in the `Builtis` type, and provide selection functions
4 -- to help extract their names.
9 sumTyCon, prodTyCon, prodDataCon,
10 selTy,selReplicate, selPick, selTags, selElements,
11 combinePDVar, scalarZip, closureCtrFun,
14 initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
15 initBuiltinPAs, initBuiltinPRs,
16 initBuiltinBoxedTyCons, initBuiltinScalars,
18 primMethod, primPArray
22 import IfaceEnv ( lookupOrig )
26 import DataCon ( DataCon, dataConName, dataConWorkId )
27 import TyCon ( TyCon, tyConName, tyConDataCons )
28 import Class ( Class, classTyCon )
29 import CoreSyn ( CoreExpr, Expr(..) )
31 import Id ( mkSysLocal )
32 import Name ( Name, getOccString )
36 import TypeRep ( funTyCon )
37 import Type ( Type, mkTyConApp )
39 import TysWiredIn ( unitDataCon,
43 boolTyCon, trueDataCon, falseDataCon,
45 import PrelNames ( word8TyConName, gHC_PARR )
46 import BasicTypes ( Boxity(..) )
52 import Control.Monad ( liftM, zipWithM )
53 import Data.List ( unzip4 )
56 -- Numbers of things exported by the DPH library.
63 mAX_DPH_COMBINE :: Int
66 mAX_DPH_SCALAR_ARGS :: Int
67 mAX_DPH_SCALAR_ARGS = 3
70 -- | Ids of the modules that contain our DPH builtins.
73 { dph_PArray :: Module
75 , dph_Closure :: Module
76 , dph_Unboxed :: Module
77 , dph_Instances :: Module
78 , dph_Combinators :: Module
79 , dph_Scalar :: Module
80 , dph_Selector :: Module
81 , dph_Prelude_PArr :: Module
82 , dph_Prelude_Int :: Module
83 , dph_Prelude_Word8 :: Module
84 , dph_Prelude_Double :: Module
85 , dph_Prelude_Bool :: Module
86 , dph_Prelude_Tuple :: Module
90 -- | The locations of builtins in the current DPH library.
91 dph_Modules :: PackageId -> Modules
94 { dph_PArray = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
95 , dph_Repr = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
96 , dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
97 , dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
98 , dph_Instances = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
99 , dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
100 , dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
101 , dph_Selector = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
103 , dph_Prelude_PArr = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
104 , dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
105 , dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
106 , dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
107 , dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
108 , dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
110 where mk = mkModule pkg . mkModuleNameFS
113 -- | Project out ids of modules that contain orphan instances that we need to load.
114 dph_Orphans :: [Modules -> Module]
115 dph_Orphans = [dph_Repr, dph_Instances]
118 -- | Information about what builtin stuff to use from the DPH base libraries.
121 { dphModules :: Modules
123 -- From dph-common:Data.Array.Parallel.Lifted.PArray
124 , parrayTyCon :: TyCon -- ^ PArray
125 , parrayDataCon :: DataCon -- ^ PArray
126 , pdataTyCon :: TyCon -- ^ PData
127 , paTyCon :: TyCon -- ^ PA
128 , paDataCon :: DataCon -- ^ PA
129 , preprTyCon :: TyCon -- ^ PRepr
130 , prTyCon :: TyCon -- ^ PR
131 , prDataCon :: DataCon -- ^ PR
132 , replicatePDVar :: Var -- ^ replicatePD
133 , emptyPDVar :: Var -- ^ emptyPD
134 , packByTagPDVar :: Var -- ^ packByTagPD
135 , combinePDVars :: Array Int Var -- ^ combinePD
136 , scalarClass :: Class -- ^ Scalar
138 -- From dph-common:Data.Array.Parallel.Lifted.Closure
139 , closureTyCon :: TyCon -- ^ :->
140 , closureVar :: Var -- ^ closure
141 , applyVar :: Var -- ^ $:
142 , liftedClosureVar :: Var -- ^ liftedClosure
143 , liftedApplyVar :: Var -- ^ liftedApply
144 , closureCtrFuns :: Array Int Var -- ^ closure1 .. closure2
146 -- From dph-common:Data.Array.Parallel.Lifted.Repr
147 , voidTyCon :: TyCon -- ^ Void
148 , wrapTyCon :: TyCon -- ^ Wrap
149 , sumTyCons :: Array Int TyCon -- ^ Sum2 .. Sum3
150 , voidVar :: Var -- ^ void
151 , pvoidVar :: Var -- ^ pvoid
152 , fromVoidVar :: Var -- ^ fromVoid
153 , punitVar :: Var -- ^ punit
155 -- From dph-common:Data.Array.Parallel.Lifted.Selector
156 , selTys :: Array Int Type -- ^ Sel2
157 , selReplicates :: Array Int CoreExpr -- ^ replicate2
158 , selPicks :: Array Int CoreExpr -- ^ pick2
159 , selTagss :: Array Int CoreExpr -- ^ tagsSel2
160 , selEls :: Array (Int, Int) CoreExpr -- ^ elementsSel2_0 .. elementsSel_2_1
162 -- From dph-common:Data.Array.Parallel.Lifted.Scalar
163 -- NOTE: map is counted as a zipWith fn with one argument array.
164 , scalarZips :: Array Int Var -- ^ map, zipWith, zipWith3
167 , liftingContext :: Var -- ^ lc
171 -- | Get an element from one of the arrays of contained by a `Builtins`.
172 -- If the indexed thing is not in the array then panic.
174 :: (Ix i, Outputable i)
175 => String -- ^ Name of the selector we've used, for panic messages.
176 -> (Builtins -> Array i a) -- ^ Field selector for the `Builtins`.
177 -> i -- ^ Index into the array.
181 indexBuiltin fn f i bi
182 | inRange (bounds xs) i = xs ! i
183 | otherwise = pprPanic fn (ppr i)
188 -- Projections ----------------------------------------------------------------
189 selTy :: Int -> Builtins -> Type
190 selTy = indexBuiltin "selTy" selTys
192 selReplicate :: Int -> Builtins -> CoreExpr
193 selReplicate = indexBuiltin "selReplicate" selReplicates
195 selPick :: Int -> Builtins -> CoreExpr
196 selPick = indexBuiltin "selPick" selPicks
198 selTags :: Int -> Builtins -> CoreExpr
199 selTags = indexBuiltin "selTags" selTagss
201 selElements :: Int -> Int -> Builtins -> CoreExpr
202 selElements i j = indexBuiltin "selElements" selEls (i,j)
204 sumTyCon :: Int -> Builtins -> TyCon
205 sumTyCon = indexBuiltin "sumTyCon" sumTyCons
207 prodTyCon :: Int -> Builtins -> TyCon
209 | n >= 2 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
210 | otherwise = pprPanic "prodTyCon" (ppr n)
212 prodDataCon :: Int -> Builtins -> DataCon
213 prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
215 _ -> pprPanic "prodDataCon" (ppr n)
217 combinePDVar :: Int -> Builtins -> Var
218 combinePDVar = indexBuiltin "combinePDVar" combinePDVars
220 scalarZip :: Int -> Builtins -> Var
221 scalarZip = indexBuiltin "scalarZip" scalarZips
223 closureCtrFun :: Int -> Builtins -> Var
224 closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
227 -- Initialisation -------------------------------------------------------------
228 -- | Create the initial map of builtin types and functions.
230 :: PackageId -- ^ package id the builtins are in, eg dph-common
235 mapM_ load dph_Orphans
237 -- From dph-common:Data.Array.Parallel.Lifted.PArray
238 parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray")
239 let [parrayDataCon] = tyConDataCons parrayTyCon
240 pdataTyCon <- externalTyCon dph_PArray (fsLit "PData")
241 paTyCon <- externalClassTyCon dph_PArray (fsLit "PA")
242 let [paDataCon] = tyConDataCons paTyCon
243 preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
244 prTyCon <- externalClassTyCon dph_PArray (fsLit "PR")
245 let [prDataCon] = tyConDataCons prTyCon
248 closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
250 -- From dph-common:Data.Array.Parallel.Lifted.Repr
251 voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
252 wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
254 -- From dph-common:Data.Array.Parallel.Lifted.Selector
255 sel_tys <- mapM (externalType dph_Selector)
256 (numbered "Sel" 2 mAX_DPH_SUM)
258 sel_replicates <- mapM (externalFun dph_Selector)
259 (numbered "replicate" 2 mAX_DPH_SUM)
261 sel_picks <- mapM (externalFun dph_Selector)
262 (numbered "pick" 2 mAX_DPH_SUM)
264 sel_tags <- mapM (externalFun dph_Selector)
265 (numbered "tagsSel" 2 mAX_DPH_SUM)
267 sel_els <- mapM mk_elements
268 [(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i-1]]
270 sum_tcs <- mapM (externalTyCon dph_Repr)
271 (numbered "Sum" 2 mAX_DPH_SUM)
273 let selTys = listArray (2, mAX_DPH_SUM) sel_tys
274 selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
275 selPicks = listArray (2, mAX_DPH_SUM) sel_picks
276 selTagss = listArray (2, mAX_DPH_SUM) sel_tags
277 selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
278 sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
281 voidVar <- externalVar dph_Repr (fsLit "void")
282 pvoidVar <- externalVar dph_Repr (fsLit "pvoid")
283 fromVoidVar <- externalVar dph_Repr (fsLit "fromVoid")
284 punitVar <- externalVar dph_Repr (fsLit "punit")
285 closureVar <- externalVar dph_Closure (fsLit "closure")
286 applyVar <- externalVar dph_Closure (fsLit "$:")
287 liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
288 liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply")
289 replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
290 emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
291 packByTagPDVar <- externalVar dph_PArray (fsLit "packByTagPD")
293 combines <- mapM (externalVar dph_PArray)
294 [mkFastString ("combine" ++ show i ++ "PD")
295 | i <- [2..mAX_DPH_COMBINE]]
296 let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
298 scalarClass <- externalClass dph_PArray (fsLit "Scalar")
299 scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
300 scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
301 scalar_zips <- mapM (externalVar dph_Scalar)
302 (numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
303 let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
304 (scalar_map : scalar_zip2 : scalar_zips)
305 closures <- mapM (externalVar dph_Closure)
306 (numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
307 let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
309 liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
314 , parrayTyCon = parrayTyCon
315 , parrayDataCon = parrayDataCon
316 , pdataTyCon = pdataTyCon
318 , paDataCon = paDataCon
319 , preprTyCon = preprTyCon
321 , prDataCon = prDataCon
322 , voidTyCon = voidTyCon
323 , wrapTyCon = wrapTyCon
325 , selReplicates = selReplicates
326 , selPicks = selPicks
327 , selTagss = selTagss
329 , sumTyCons = sumTyCons
330 , closureTyCon = closureTyCon
332 , pvoidVar = pvoidVar
333 , fromVoidVar = fromVoidVar
334 , punitVar = punitVar
335 , closureVar = closureVar
336 , applyVar = applyVar
337 , liftedClosureVar = liftedClosureVar
338 , liftedApplyVar = liftedApplyVar
339 , replicatePDVar = replicatePDVar
340 , emptyPDVar = emptyPDVar
341 , packByTagPDVar = packByTagPDVar
342 , combinePDVars = combinePDVars
343 , scalarClass = scalarClass
344 , scalarZips = scalarZips
345 , closureCtrFuns = closureCtrFuns
346 , liftingContext = liftingContext
350 dph_PArray = dph_PArray
351 , dph_Repr = dph_Repr
352 , dph_Closure = dph_Closure
353 , dph_Selector = dph_Selector
354 , dph_Scalar = dph_Scalar
358 load get_mod = dsLoadModule doc mod
360 mod = get_mod modules
361 doc = ppr mod <+> ptext (sLit "is a DPH module")
363 -- Make a list of numbered strings in some range, eg foo3, foo4, foo5
364 numbered :: String -> Int -> Int -> [FastString]
365 numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
367 mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
370 v <- externalVar dph_Selector
371 $ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
372 return ((i,j), Var v)
375 -- | Get the mapping of names in the Prelude to names in the DPH library.
376 initBuiltinVars :: Builtins -> DsM [(Var, Var)]
377 initBuiltinVars (Builtins { dphModules = mods })
379 uvars <- zipWithM externalVar umods ufs
380 vvars <- zipWithM externalVar vmods vfs
381 cvars <- zipWithM externalVar cmods cfs
382 return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
383 ++ zip (map dataConWorkId cons) cvars
386 (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
387 (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
389 defaultDataConWorkers :: [DataCon]
390 defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
392 preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
393 preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
394 = [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
396 mk_tup n mod name = (tupleCon Boxed n, mod, name)
399 -- | Mapping of prelude functions to vectorised versions.
400 -- Functions like filterP currently have a working but naive version in GHC.PArr
401 -- During vectorisation we replace these by calls to filterPA, which are
402 -- defined in dph-common Data.Array.Parallel.Lifted.Combinators
404 -- As renamer only sees the GHC.PArr functions, if you want to add a new function
405 -- to the vectoriser there has to be a definition for it in GHC.PArr, even though
406 -- it will never be used at runtime.
408 preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
409 preludeVars (Modules { dph_Combinators = dph_Combinators
410 , dph_PArray = dph_PArray
411 , dph_Prelude_Int = dph_Prelude_Int
412 , dph_Prelude_Word8 = dph_Prelude_Word8
413 , dph_Prelude_Double = dph_Prelude_Double
414 , dph_Prelude_Bool = dph_Prelude_Bool
415 , dph_Prelude_PArr = dph_Prelude_PArr
418 -- Functions that work on whole PArrays, defined in GHC.PArr
419 = [ mk gHC_PARR (fsLit "mapP") dph_Combinators (fsLit "mapPA")
420 , mk gHC_PARR (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
421 , mk gHC_PARR (fsLit "zipP") dph_Combinators (fsLit "zipPA")
422 , mk gHC_PARR (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
423 , mk gHC_PARR (fsLit "filterP") dph_Combinators (fsLit "filterPA")
424 , mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
425 , mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
426 , mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA")
427 , mk gHC_PARR (fsLit "sliceP") dph_Combinators (fsLit "slicePA")
428 , mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
429 , mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
430 , mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA")
431 , mk gHC_PARR (fsLit "+:+") dph_Combinators (fsLit "appPA")
432 , mk gHC_PARR (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
434 -- Map scalar functions to versions using closures.
435 , mk' dph_Prelude_Int "div" "divV"
436 , mk' dph_Prelude_Int "mod" "modV"
437 , mk' dph_Prelude_Int "sqrt" "sqrtV"
438 , mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
439 -- , mk' dph_Prelude_Int "upToP" "upToPA"
441 ++ vars_Ord dph_Prelude_Int
442 ++ vars_Num dph_Prelude_Int
444 ++ vars_Ord dph_Prelude_Word8
445 ++ vars_Num dph_Prelude_Word8
447 [ mk' dph_Prelude_Word8 "div" "divV"
448 , mk' dph_Prelude_Word8 "mod" "modV"
449 , mk' dph_Prelude_Word8 "fromInt" "fromIntV"
450 , mk' dph_Prelude_Word8 "toInt" "toIntV"
453 ++ vars_Ord dph_Prelude_Double
454 ++ vars_Num dph_Prelude_Double
455 ++ vars_Fractional dph_Prelude_Double
456 ++ vars_Floating dph_Prelude_Double
457 ++ vars_RealFrac dph_Prelude_Double
459 [ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
460 , mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
463 , mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
464 , mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
465 , mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
466 , mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
470 mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
473 = [ mk' mod "==" "eqV"
474 , mk' mod "/=" "neqV"
479 , mk' mod "min" "minV"
480 , mk' mod "max" "maxV"
481 , mk' mod "minimumP" "minimumPA"
482 , mk' mod "maximumP" "maximumPA"
483 , mk' mod "minIndexP" "minIndexPA"
484 , mk' mod "maxIndexP" "maxIndexPA"
488 = [ mk' mod "+" "plusV"
489 , mk' mod "-" "minusV"
490 , mk' mod "*" "multV"
491 , mk' mod "negate" "negateV"
492 , mk' mod "abs" "absV"
493 , mk' mod "sumP" "sumPA"
494 , mk' mod "productP" "productPA"
498 = [ mk' mod "/" "divideV"
499 , mk' mod "recip" "recipV"
503 = [ mk' mod "pi" "pi"
504 , mk' mod "exp" "expV"
505 , mk' mod "sqrt" "sqrtV"
506 , mk' mod "log" "logV"
507 , mk' mod "sin" "sinV"
508 , mk' mod "tan" "tanV"
509 , mk' mod "cos" "cosV"
510 , mk' mod "asin" "asinV"
511 , mk' mod "atan" "atanV"
512 , mk' mod "acos" "acosV"
513 , mk' mod "sinh" "sinhV"
514 , mk' mod "tanh" "tanhV"
515 , mk' mod "cosh" "coshV"
516 , mk' mod "asinh" "asinhV"
517 , mk' mod "atanh" "atanhV"
518 , mk' mod "acosh" "acoshV"
519 , mk' mod "**" "powV"
520 , mk' mod "logBase" "logBaseV"
524 = [ mk' mod "fromInt" "fromIntV"
525 , mk' mod "truncate" "truncateV"
526 , mk' mod "round" "roundV"
527 , mk' mod "ceiling" "ceilingV"
528 , mk' mod "floor" "floorV"
532 -- | Get a list of names to `TyCon`s in the mock prelude.
533 initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
536 -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
537 dft_tcs <- defaultTyCons
538 return $ (tyConName funTyCon, closureTyCon bi)
539 : (parrTyConName, parrayTyCon bi)
542 : (tyConName $ parrayTyCon bi, parrayTyCon bi)
544 : [(tyConName tc, tc) | tc <- dft_tcs]
546 defaultTyCons :: DsM [TyCon]
549 word8 <- dsLookupTyCon word8TyConName
550 return [intTyCon, boolTyCon, doubleTyCon, word8]
553 -- | Get a list of names to `DataCon`s in the mock prelude.
554 initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
555 initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
557 defaultDataCons :: [DataCon]
558 defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
561 -- | Get the names of all buildin instance functions for the PA class.
562 initBuiltinPAs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
563 initBuiltinPAs (Builtins { dphModules = mods }) insts
564 = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PA"))
567 -- | Get the names of all builtin instance functions for the PR class.
568 initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
569 initBuiltinPRs (Builtins { dphModules = mods }) insts
570 = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PR"))
573 -- | Get the names of all DPH instance functions for this class.
574 initBuiltinDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
575 initBuiltinDicts insts cls = map find $ classInstances insts cls
577 find i | [Just tc] <- instanceRoughTcs i = (tc, instanceDFunId i)
578 | otherwise = pprPanic "Invalid DPH instance" (ppr i)
581 -- | Get a list of boxed `TyCons` in the mock prelude. This is Int only.
582 initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
583 initBuiltinBoxedTyCons = return . builtinBoxedTyCons
585 builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
587 = [(tyConName intPrimTyCon, intTyCon)]
590 -- | Get a list of all scalar functions in the mock prelude.
591 initBuiltinScalars :: Builtins -> DsM [Var]
592 initBuiltinScalars bi
593 = mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
596 preludeScalars :: Modules -> [(Module, FastString)]
597 preludeScalars (Modules { dph_Prelude_Int = dph_Prelude_Int
598 , dph_Prelude_Word8 = dph_Prelude_Word8
599 , dph_Prelude_Double = dph_Prelude_Double
601 = [ mk dph_Prelude_Int "div"
602 , mk dph_Prelude_Int "mod"
603 , mk dph_Prelude_Int "sqrt"
605 ++ scalars_Ord dph_Prelude_Int
606 ++ scalars_Num dph_Prelude_Int
608 ++ scalars_Ord dph_Prelude_Word8
609 ++ scalars_Num dph_Prelude_Word8
611 [ mk dph_Prelude_Word8 "div"
612 , mk dph_Prelude_Word8 "mod"
613 , mk dph_Prelude_Word8 "fromInt"
614 , mk dph_Prelude_Word8 "toInt"
617 ++ scalars_Ord dph_Prelude_Double
618 ++ scalars_Num dph_Prelude_Double
619 ++ scalars_Fractional dph_Prelude_Double
620 ++ scalars_Floating dph_Prelude_Double
621 ++ scalars_RealFrac dph_Prelude_Double
623 mk mod s = (mod, fsLit s)
644 scalars_Fractional mod
679 -- | Lookup some variable given its name and the module that contains it.
680 externalVar :: Module -> FastString -> DsM Var
682 = dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
685 -- | Like `externalVar` but wrap the `Var` in a `CoreExpr`
686 externalFun :: Module -> FastString -> DsM CoreExpr
688 = do var <- externalVar mod fs
692 -- | Lookup some `TyCon` given its name and the module that contains it.
693 externalTyCon :: Module -> FastString -> DsM TyCon
695 = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
698 -- | Lookup some `Type` given its name and the module that contains it.
699 externalType :: Module -> FastString -> DsM Type
701 = do tycon <- externalTyCon mod fs
702 return $ mkTyConApp tycon []
705 -- | Lookup some `Class` given its name and the module that contains it.
706 externalClass :: Module -> FastString -> DsM Class
708 = dsLookupClass =<< lookupOrig mod (mkClsOccFS fs)
711 -- | Like `externalClass`, but get the TyCon of of the class.
712 externalClassTyCon :: Module -> FastString -> DsM TyCon
713 externalClassTyCon mod fs = liftM classTyCon (externalClass mod fs)
716 -- | Lookup a method function given its name and instance type.
717 primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
718 primMethod tycon method (Builtins { dphModules = mods })
719 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
721 $ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
722 (mkVarOcc $ method ++ suffix)
724 | otherwise = return Nothing
726 -- | Lookup the representation type we use for PArrays that contain a given element type.
727 primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
728 primPArray tycon (Builtins { dphModules = mods })
729 | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
731 $ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
732 (mkTcOcc $ "PArray" ++ suffix)
734 | otherwise = return Nothing
736 prim_ty_cons :: NameEnv String
737 prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
739 mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)