module VectBuiltIn (
Builtins(..), sumTyCon, prodTyCon, prodDataCon,
selTy, selReplicate, selPick, selElements,
combinePDVar, scalarZip, closureCtrFun,
initBuiltins, initBuiltinVars, initBuiltinTyCons, initBuiltinDataCons,
initBuiltinPAs, initBuiltinPRs,
initBuiltinBoxedTyCons, initBuiltinScalars,
primMethod, primPArray
) where
import DsMonad
import IfaceEnv ( lookupOrig )
import Module
import DataCon ( DataCon, dataConName, dataConWorkId )
import TyCon ( TyCon, tyConName, tyConDataCons )
import Class ( Class )
import CoreSyn ( CoreExpr, Expr(..) )
import Var ( Var )
import Id ( mkSysLocal )
import Name ( Name, getOccString )
import NameEnv
import OccName
import TypeRep ( funTyCon )
import Type ( Type, mkTyConApp )
import TysPrim
import TysWiredIn ( unitTyCon, unitDataCon,
tupleTyCon, tupleCon,
intTyCon, intTyConName,
doubleTyCon, doubleTyConName,
boolTyCon, boolTyConName, trueDataCon, falseDataCon,
parrTyConName )
import PrelNames ( word8TyConName, gHC_PARR )
import BasicTypes ( Boxity(..) )
import FastString
import Outputable
import Data.Array
import Control.Monad ( liftM, zipWithM )
import Data.List ( unzip4 )
mAX_DPH_PROD :: Int
mAX_DPH_PROD = 5
mAX_DPH_SUM :: Int
mAX_DPH_SUM = 2
mAX_DPH_COMBINE :: Int
mAX_DPH_COMBINE = 2
mAX_DPH_SCALAR_ARGS :: Int
mAX_DPH_SCALAR_ARGS = 3
data Modules = Modules {
dph_PArray :: Module
, dph_Repr :: Module
, dph_Closure :: Module
, dph_Unboxed :: Module
, dph_Instances :: Module
, dph_Combinators :: Module
, dph_Scalar :: Module
, dph_Selector :: Module
, dph_Prelude_PArr :: Module
, dph_Prelude_Int :: Module
, dph_Prelude_Word8 :: Module
, dph_Prelude_Double :: Module
, dph_Prelude_Bool :: Module
, dph_Prelude_Tuple :: Module
}
dph_Modules :: PackageId -> Modules
dph_Modules pkg = Modules {
dph_PArray = mk (fsLit "Data.Array.Parallel.Lifted.PArray")
, dph_Repr = mk (fsLit "Data.Array.Parallel.Lifted.Repr")
, dph_Closure = mk (fsLit "Data.Array.Parallel.Lifted.Closure")
, dph_Unboxed = mk (fsLit "Data.Array.Parallel.Lifted.Unboxed")
, dph_Instances = mk (fsLit "Data.Array.Parallel.Lifted.Instances")
, dph_Combinators = mk (fsLit "Data.Array.Parallel.Lifted.Combinators")
, dph_Scalar = mk (fsLit "Data.Array.Parallel.Lifted.Scalar")
, dph_Selector = mk (fsLit "Data.Array.Parallel.Lifted.Selector")
, dph_Prelude_PArr = mk (fsLit "Data.Array.Parallel.Prelude.Base.PArr")
, dph_Prelude_Int = mk (fsLit "Data.Array.Parallel.Prelude.Base.Int")
, dph_Prelude_Word8 = mk (fsLit "Data.Array.Parallel.Prelude.Base.Word8")
, dph_Prelude_Double = mk (fsLit "Data.Array.Parallel.Prelude.Base.Double")
, dph_Prelude_Bool = mk (fsLit "Data.Array.Parallel.Prelude.Base.Bool")
, dph_Prelude_Tuple = mk (fsLit "Data.Array.Parallel.Prelude.Base.Tuple")
}
where
mk = mkModule pkg . mkModuleNameFS
data Builtins = Builtins {
dphModules :: Modules
, parrayTyCon :: TyCon
, parrayDataCon :: DataCon
, pdataTyCon :: TyCon
, paTyCon :: TyCon
, paDataCon :: DataCon
, preprTyCon :: TyCon
, prTyCon :: TyCon
, prDataCon :: DataCon
, voidTyCon :: TyCon
, wrapTyCon :: TyCon
, selTys :: Array Int Type
, selReplicates :: Array Int CoreExpr
, selPicks :: Array Int CoreExpr
, selEls :: Array (Int, Int) CoreExpr
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
, voidVar :: Var
, pvoidVar :: Var
, punitVar :: Var
, mkPRVar :: Var
, closureVar :: Var
, applyVar :: Var
, liftedClosureVar :: Var
, liftedApplyVar :: Var
, replicatePDVar :: Var
, emptyPDVar :: Var
, packPDVar :: Var
, combinePDVars :: Array Int Var
, scalarClass :: Class
, scalarZips :: Array Int Var
, closureCtrFuns :: Array Int Var
, liftingContext :: Var
}
indexBuiltin :: (Ix i, Outputable i) => String -> (Builtins -> Array i a)
-> i -> Builtins -> a
indexBuiltin fn f i bi
| inRange (bounds xs) i = xs ! i
| otherwise = pprPanic fn (ppr i)
where
xs = f bi
selTy :: Int -> Builtins -> Type
selTy = indexBuiltin "selTy" selTys
selReplicate :: Int -> Builtins -> CoreExpr
selReplicate = indexBuiltin "selReplicate" selReplicates
selPick :: Int -> Builtins -> CoreExpr
selPick = indexBuiltin "selPick" selPicks
selElements :: Int -> Int -> Builtins -> CoreExpr
selElements i j = indexBuiltin "selElements" selEls (i,j)
sumTyCon :: Int -> Builtins -> TyCon
sumTyCon = indexBuiltin "sumTyCon" sumTyCons
prodTyCon :: Int -> Builtins -> TyCon
prodTyCon n bi
| n == 1 = wrapTyCon bi
| n >= 0 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
| otherwise = pprPanic "prodTyCon" (ppr n)
prodDataCon :: Int -> Builtins -> DataCon
prodDataCon n bi = case tyConDataCons (prodTyCon n bi) of
[con] -> con
_ -> pprPanic "prodDataCon" (ppr n)
combinePDVar :: Int -> Builtins -> Var
combinePDVar = indexBuiltin "combinePDVar" combinePDVars
scalarZip :: Int -> Builtins -> Var
scalarZip = indexBuiltin "scalarZip" scalarZips
closureCtrFun :: Int -> Builtins -> Var
closureCtrFun = indexBuiltin "closureCtrFun" closureCtrFuns
initBuiltins :: PackageId -> DsM Builtins
initBuiltins pkg
= do
parrayTyCon <- externalTyCon dph_PArray (fsLit "PArray")
let [parrayDataCon] = tyConDataCons parrayTyCon
pdataTyCon <- externalTyCon dph_PArray (fsLit "PData")
paTyCon <- externalTyCon dph_PArray (fsLit "PA")
let [paDataCon] = tyConDataCons paTyCon
preprTyCon <- externalTyCon dph_PArray (fsLit "PRepr")
prTyCon <- externalTyCon dph_PArray (fsLit "PR")
let [prDataCon] = tyConDataCons prTyCon
closureTyCon <- externalTyCon dph_Closure (fsLit ":->")
voidTyCon <- externalTyCon dph_Repr (fsLit "Void")
wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
sel_tys <- mapM (externalType dph_Selector)
(numbered "Sel" 2 mAX_DPH_SUM)
sel_replicates <- mapM (externalFun dph_Selector)
(numbered "replicate" 2 mAX_DPH_SUM)
sel_picks <- mapM (externalFun dph_Selector)
(numbered "pick" 2 mAX_DPH_SUM)
sel_els <- mapM mk_elements
[(i,j) | i <- [2..mAX_DPH_SUM], j <- [0..i1]]
sum_tcs <- mapM (externalTyCon dph_Repr)
(numbered "Sum" 2 mAX_DPH_SUM)
let selTys = listArray (2, mAX_DPH_SUM) sel_tys
selReplicates = listArray (2, mAX_DPH_SUM) sel_replicates
selPicks = listArray (2, mAX_DPH_SUM) sel_picks
selEls = array ((2,0), (mAX_DPH_SUM, mAX_DPH_SUM)) sel_els
sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
voidVar <- externalVar dph_Repr (fsLit "void")
pvoidVar <- externalVar dph_Repr (fsLit "pvoid")
punitVar <- externalVar dph_Repr (fsLit "punit")
mkPRVar <- externalVar dph_PArray (fsLit "mkPR")
closureVar <- externalVar dph_Closure (fsLit "closure")
applyVar <- externalVar dph_Closure (fsLit "$:")
liftedClosureVar <- externalVar dph_Closure (fsLit "liftedClosure")
liftedApplyVar <- externalVar dph_Closure (fsLit "liftedApply")
replicatePDVar <- externalVar dph_PArray (fsLit "replicatePD")
emptyPDVar <- externalVar dph_PArray (fsLit "emptyPD")
packPDVar <- externalVar dph_PArray (fsLit "packPD")
combines <- mapM (externalVar dph_PArray)
[mkFastString ("combine" ++ show i ++ "PD")
| i <- [2..mAX_DPH_COMBINE]]
let combinePDVars = listArray (2, mAX_DPH_COMBINE) combines
scalarClass <- externalClass dph_Scalar (fsLit "Scalar")
scalar_map <- externalVar dph_Scalar (fsLit "scalar_map")
scalar_zip2 <- externalVar dph_Scalar (fsLit "scalar_zipWith")
scalar_zips <- mapM (externalVar dph_Scalar)
(numbered "scalar_zipWith" 3 mAX_DPH_SCALAR_ARGS)
let scalarZips = listArray (1, mAX_DPH_SCALAR_ARGS)
(scalar_map : scalar_zip2 : scalar_zips)
closures <- mapM (externalVar dph_Closure)
(numbered "closure" 1 mAX_DPH_SCALAR_ARGS)
let closureCtrFuns = listArray (1, mAX_DPH_COMBINE) closures
liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
newUnique
return $ Builtins {
dphModules = modules
, parrayTyCon = parrayTyCon
, parrayDataCon = parrayDataCon
, pdataTyCon = pdataTyCon
, paTyCon = paTyCon
, paDataCon = paDataCon
, preprTyCon = preprTyCon
, prTyCon = prTyCon
, prDataCon = prDataCon
, voidTyCon = voidTyCon
, wrapTyCon = wrapTyCon
, selTys = selTys
, selReplicates = selReplicates
, selPicks = selPicks
, selEls = selEls
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
, voidVar = voidVar
, pvoidVar = pvoidVar
, punitVar = punitVar
, mkPRVar = mkPRVar
, closureVar = closureVar
, applyVar = applyVar
, liftedClosureVar = liftedClosureVar
, liftedApplyVar = liftedApplyVar
, replicatePDVar = replicatePDVar
, emptyPDVar = emptyPDVar
, packPDVar = packPDVar
, combinePDVars = combinePDVars
, scalarClass = scalarClass
, scalarZips = scalarZips
, closureCtrFuns = closureCtrFuns
, liftingContext = liftingContext
}
where
modules@(Modules {
dph_PArray = dph_PArray
, dph_Repr = dph_Repr
, dph_Closure = dph_Closure
, dph_Selector = dph_Selector
, dph_Scalar = dph_Scalar
})
= dph_Modules pkg
numbered :: String -> Int -> Int -> [FastString]
numbered pfx m n = [mkFastString (pfx ++ show i) | i <- [m..n]]
mk_elements :: (Int, Int) -> DsM ((Int, Int), CoreExpr)
mk_elements (i,j)
= do
v <- externalVar dph_Selector
$ mkFastString ("elementsSel" ++ show i ++ "_" ++ show j ++ "#")
return ((i,j), Var v)
initBuiltinVars :: Builtins -> DsM [(Var, Var)]
initBuiltinVars (Builtins { dphModules = mods })
= do
uvars <- zipWithM externalVar umods ufs
vvars <- zipWithM externalVar vmods vfs
cvars <- zipWithM externalVar cmods cfs
return $ [(v,v) | v <- map dataConWorkId defaultDataConWorkers]
++ zip (map dataConWorkId cons) cvars
++ zip uvars vvars
where
(umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
(cons, cmods, cfs) = unzip3 (preludeDataCons mods)
defaultDataConWorkers :: [DataCon]
defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
preludeDataCons :: Modules -> [(DataCon, Module, FastString)]
preludeDataCons (Modules { dph_Prelude_Tuple = dph_Prelude_Tuple })
= [mk_tup n dph_Prelude_Tuple (mkFastString $ "tup" ++ show n) | n <- [2..3]]
where
mk_tup n mod name = (tupleCon Boxed n, mod, name)
preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
preludeVars (Modules { dph_Combinators = dph_Combinators
, dph_PArray = dph_PArray
, dph_Prelude_Int = dph_Prelude_Int
, dph_Prelude_Word8 = dph_Prelude_Word8
, dph_Prelude_Double = dph_Prelude_Double
, dph_Prelude_Bool = dph_Prelude_Bool
, dph_Prelude_PArr = dph_Prelude_PArr
})
= [
mk gHC_PARR (fsLit "mapP") dph_Combinators (fsLit "mapPA")
, mk gHC_PARR (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
, mk gHC_PARR (fsLit "zipP") dph_Combinators (fsLit "zipPA")
, mk gHC_PARR (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
, mk gHC_PARR (fsLit "filterP") dph_Combinators (fsLit "filterPA")
, mk gHC_PARR (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
, mk gHC_PARR (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
, mk gHC_PARR (fsLit "!:") dph_Combinators (fsLit "indexPA")
, mk gHC_PARR (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
, mk gHC_PARR (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
, mk gHC_PARR (fsLit "concatP") dph_Combinators (fsLit "concatPA")
, mk gHC_PARR (fsLit "+:+") dph_Combinators (fsLit "appPA")
, mk gHC_PARR (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
, mk' dph_Prelude_Int "div" "divV"
, mk' dph_Prelude_Int "mod" "modV"
, mk' dph_Prelude_Int "sqrt" "sqrtV"
, mk' dph_Prelude_Int "enumFromToP" "enumFromToPA"
]
++ vars_Ord dph_Prelude_Int
++ vars_Num dph_Prelude_Int
++ vars_Ord dph_Prelude_Word8
++ vars_Num dph_Prelude_Word8
++
[ mk' dph_Prelude_Word8 "div" "divV"
, mk' dph_Prelude_Word8 "mod" "modV"
, mk' dph_Prelude_Word8 "fromInt" "fromIntV"
, mk' dph_Prelude_Word8 "toInt" "toIntV"
]
++ vars_Ord dph_Prelude_Double
++ vars_Num dph_Prelude_Double
++ vars_Fractional dph_Prelude_Double
++ vars_Floating dph_Prelude_Double
++ vars_RealFrac dph_Prelude_Double
++
[ mk dph_Prelude_Bool (fsLit "andP") dph_Prelude_Bool (fsLit "andPA")
, mk dph_Prelude_Bool (fsLit "orP") dph_Prelude_Bool (fsLit "orPA")
, mk dph_Prelude_PArr (fsLit "fromPArrayP") dph_Prelude_PArr (fsLit "fromPArrayPA")
, mk dph_Prelude_PArr (fsLit "toPArrayP") dph_Prelude_PArr (fsLit "toPArrayPA")
, mk dph_Prelude_PArr (fsLit "fromNestedPArrayP") dph_Prelude_PArr (fsLit "fromNestedPArrayPA")
, mk dph_Prelude_PArr (fsLit "combineP") dph_Combinators (fsLit "combine2PA")
]
where
mk = (,,,)
mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
vars_Ord mod = [mk' mod "==" "eqV"
,mk' mod "/=" "neqV"
,mk' mod "<=" "leV"
,mk' mod "<" "ltV"
,mk' mod ">=" "geV"
,mk' mod ">" "gtV"
,mk' mod "min" "minV"
,mk' mod "max" "maxV"
,mk' mod "minimumP" "minimumPA"
,mk' mod "maximumP" "maximumPA"
,mk' mod "minIndexP" "minIndexPA"
,mk' mod "maxIndexP" "maxIndexPA"
]
vars_Num mod = [mk' mod "+" "plusV"
,mk' mod "-" "minusV"
,mk' mod "*" "multV"
,mk' mod "negate" "negateV"
,mk' mod "abs" "absV"
,mk' mod "sumP" "sumPA"
,mk' mod "productP" "productPA"
]
vars_Fractional mod = [mk' mod "/" "divideV"
,mk' mod "recip" "recipV"
]
vars_Floating mod = [mk' mod "pi" "pi"
,mk' mod "exp" "expV"
,mk' mod "sqrt" "sqrtV"
,mk' mod "log" "logV"
,mk' mod "sin" "sinV"
,mk' mod "tan" "tanV"
,mk' mod "cos" "cosV"
,mk' mod "asin" "asinV"
,mk' mod "atan" "atanV"
,mk' mod "acos" "acosV"
,mk' mod "sinh" "sinhV"
,mk' mod "tanh" "tanhV"
,mk' mod "cosh" "coshV"
,mk' mod "asinh" "asinhV"
,mk' mod "atanh" "atanhV"
,mk' mod "acosh" "acoshV"
,mk' mod "**" "powV"
,mk' mod "logBase" "logBaseV"
]
vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
,mk' mod "truncate" "truncateV"
,mk' mod "round" "roundV"
,mk' mod "ceiling" "ceilingV"
,mk' mod "floor" "floorV"
]
initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
initBuiltinTyCons bi
= do
dft_tcs <- defaultTyCons
return $ (tyConName funTyCon, closureTyCon bi)
: (parrTyConName, parrayTyCon bi)
: (tyConName $ parrayTyCon bi, parrayTyCon bi)
: [(tyConName tc, tc) | tc <- dft_tcs]
defaultTyCons :: DsM [TyCon]
defaultTyCons
= do
word8 <- dsLookupTyCon word8TyConName
return [intTyCon, boolTyCon, doubleTyCon, word8]
initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
defaultDataCons :: [DataCon]
defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
initBuiltinDicts :: [(Name, Module, FastString)] -> DsM [(Name, Var)]
initBuiltinDicts ps
= do
dicts <- zipWithM externalVar mods fss
return $ zip tcs dicts
where
(tcs, mods, fss) = unzip3 ps
initBuiltinPAs :: Builtins -> DsM [(Name, Var)]
initBuiltinPAs = initBuiltinDicts . builtinPAs
builtinPAs :: Builtins -> [(Name, Module, FastString)]
builtinPAs bi@(Builtins { dphModules = mods })
= [
mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "dPA_Clo")
, mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "dPA_Void")
, mk (tyConName $ parrayTyCon bi) (dph_Instances mods) (fsLit "dPA_PArray")
, mk unitTyConName (dph_Instances mods) (fsLit "dPA_Unit")
, mk intTyConName (dph_Instances mods) (fsLit "dPA_Int")
, mk word8TyConName (dph_Instances mods) (fsLit "dPA_Word8")
, mk doubleTyConName (dph_Instances mods) (fsLit "dPA_Double")
, mk boolTyConName (dph_Instances mods) (fsLit "dPA_Bool")
]
++ tups
where
mk name mod fs = (name, mod, fs)
tups = map mk_tup [2..mAX_DPH_PROD]
mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
(dph_Instances mods)
(mkFastString $ "dPA_" ++ show n)
initBuiltinPRs :: Builtins -> DsM [(Name, Var)]
initBuiltinPRs = initBuiltinDicts . builtinPRs
builtinPRs :: Builtins -> [(Name, Module, FastString)]
builtinPRs bi@(Builtins { dphModules = mods }) =
[
mk (tyConName unitTyCon) (dph_Repr mods) (fsLit "dPR_Unit")
, mk (tyConName $ voidTyCon bi) (dph_Repr mods) (fsLit "dPR_Void")
, mk (tyConName $ wrapTyCon bi) (dph_Repr mods) (fsLit "dPR_Wrap")
, mk (tyConName $ closureTyCon bi) (dph_Closure mods) (fsLit "dPR_Clo")
, mk intTyConName (dph_Instances mods) (fsLit "dPR_Int")
, mk word8TyConName (dph_Instances mods) (fsLit "dPR_Word8")
, mk doubleTyConName (dph_Instances mods) (fsLit "dPR_Double")
]
++ map mk_sum [2..mAX_DPH_SUM]
++ map mk_prod [2..mAX_DPH_PROD]
where
mk name mod fs = (name, mod, fs)
mk_sum n = (tyConName $ sumTyCon n bi, dph_Repr mods,
mkFastString ("dPR_Sum" ++ show n))
mk_prod n = (tyConName $ prodTyCon n bi, dph_Repr mods,
mkFastString ("dPR_" ++ show n))
initBuiltinBoxedTyCons :: Builtins -> DsM [(Name, TyCon)]
initBuiltinBoxedTyCons = return . builtinBoxedTyCons
builtinBoxedTyCons :: Builtins -> [(Name, TyCon)]
builtinBoxedTyCons _ =
[(tyConName intPrimTyCon, intTyCon)]
initBuiltinScalars :: Builtins -> DsM [Var]
initBuiltinScalars bi
= mapM (uncurry externalVar) (preludeScalars $ dphModules bi)
preludeScalars :: Modules -> [(Module, FastString)]
preludeScalars (Modules { dph_Prelude_Int = dph_Prelude_Int
, dph_Prelude_Word8 = dph_Prelude_Word8
, dph_Prelude_Double = dph_Prelude_Double
})
= [
mk dph_Prelude_Int "div"
, mk dph_Prelude_Int "mod"
, mk dph_Prelude_Int "sqrt"
]
++ scalars_Ord dph_Prelude_Int
++ scalars_Num dph_Prelude_Int
++ scalars_Ord dph_Prelude_Word8
++ scalars_Num dph_Prelude_Word8
++
[ mk dph_Prelude_Word8 "div"
, mk dph_Prelude_Word8 "mod"
, mk dph_Prelude_Word8 "fromInt"
, mk dph_Prelude_Word8 "toInt"
]
++ scalars_Ord dph_Prelude_Double
++ scalars_Num dph_Prelude_Double
++ scalars_Fractional dph_Prelude_Double
++ scalars_Floating dph_Prelude_Double
++ scalars_RealFrac dph_Prelude_Double
where
mk mod s = (mod, fsLit s)
scalars_Ord mod = [mk mod "=="
,mk mod "/="
,mk mod "<="
,mk mod "<"
,mk mod ">="
,mk mod ">"
,mk mod "min"
,mk mod "max"
]
scalars_Num mod = [mk mod "+"
,mk mod "-"
,mk mod "*"
,mk mod "negate"
,mk mod "abs"
]
scalars_Fractional mod = [mk mod "/"
,mk mod "recip"
]
scalars_Floating mod = [mk mod "pi"
,mk mod "exp"
,mk mod "sqrt"
,mk mod "log"
,mk mod "sin"
,mk mod "tan"
,mk mod "cos"
,mk mod "asin"
,mk mod "atan"
,mk mod "acos"
,mk mod "sinh"
,mk mod "tanh"
,mk mod "cosh"
,mk mod "asinh"
,mk mod "atanh"
,mk mod "acosh"
,mk mod "**"
,mk mod "logBase"
]
scalars_RealFrac mod = [mk mod "fromInt"
,mk mod "truncate"
,mk mod "round"
,mk mod "ceiling"
,mk mod "floor"
]
externalVar :: Module -> FastString -> DsM Var
externalVar mod fs
= dsLookupGlobalId =<< lookupOrig mod (mkVarOccFS fs)
externalFun :: Module -> FastString -> DsM CoreExpr
externalFun mod fs
= do
var <- externalVar mod fs
return $ Var var
externalTyCon :: Module -> FastString -> DsM TyCon
externalTyCon mod fs
= dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
externalType :: Module -> FastString -> DsM Type
externalType mod fs
= do
tycon <- externalTyCon mod fs
return $ mkTyConApp tycon []
externalClass :: Module -> FastString -> DsM Class
externalClass mod fs
= dsLookupClass =<< lookupOrig mod (mkTcOccFS fs)
unitTyConName :: Name
unitTyConName = tyConName unitTyCon
primMethod :: TyCon -> String -> Builtins -> DsM (Maybe Var)
primMethod tycon method (Builtins { dphModules = mods })
| Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
= liftM Just
$ dsLookupGlobalId =<< lookupOrig (dph_Unboxed mods)
(mkVarOcc $ method ++ suffix)
| otherwise = return Nothing
primPArray :: TyCon -> Builtins -> DsM (Maybe TyCon)
primPArray tycon (Builtins { dphModules = mods })
| Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
= liftM Just
$ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
(mkTcOcc $ "PArray" ++ suffix)
| otherwise = return Nothing
prim_ty_cons :: NameEnv String
prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
where
mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)