import Control.Monad ( liftM, zipWithM )
import Data.List ( unzip4 )
-mAX_NDP_PROD :: Int
-mAX_NDP_PROD = 5
+mAX_DPH_PROD :: Int
+mAX_DPH_PROD = 5
-mAX_NDP_SUM :: Int
-mAX_NDP_SUM = 3
+mAX_DPH_SUM :: Int
+mAX_DPH_SUM = 3
-mAX_NDP_COMBINE :: Int
-mAX_NDP_COMBINE = 2
+mAX_DPH_COMBINE :: Int
+mAX_DPH_COMBINE = 2
data Modules = Modules {
dph_PArray :: Module
sumTyCon :: Int -> Builtins -> TyCon
sumTyCon n bi
- | n >= 2 && n <= mAX_NDP_SUM = sumTyCons bi ! n
+ | n >= 2 && n <= mAX_DPH_SUM = sumTyCons bi ! n
| otherwise = pprPanic "sumTyCon" (ppr n)
prodTyCon :: Int -> Builtins -> TyCon
prodTyCon n bi
| n == 1 = wrapTyCon bi
- | n >= 0 && n <= mAX_NDP_PROD = tupleTyCon Boxed n
+ | n >= 0 && n <= mAX_DPH_PROD = tupleTyCon Boxed n
| otherwise = pprPanic "prodTyCon" (ppr n)
combinePAVar :: Int -> Builtins -> Var
combinePAVar n bi
- | n >= 2 && n <= mAX_NDP_COMBINE = combinePAVars bi ! n
+ | n >= 2 && n <= mAX_DPH_COMBINE = combinePAVars bi ! n
| otherwise = pprPanic "combinePAVar" (ppr n)
initBuiltins :: PackageId -> DsM Builtins
wrapTyCon <- externalTyCon dph_Repr (fsLit "Wrap")
enumerationTyCon <- externalTyCon dph_Repr (fsLit "Enumeration")
sum_tcs <- mapM (externalTyCon dph_Repr)
- [mkFastString ("Sum" ++ show i) | i <- [2..mAX_NDP_SUM]]
+ [mkFastString ("Sum" ++ show i) | i <- [2..mAX_DPH_SUM]]
- let sumTyCons = listArray (2, mAX_NDP_SUM) sum_tcs
+ let sumTyCons = listArray (2, mAX_DPH_SUM) sum_tcs
voidVar <- externalVar dph_Repr (fsLit "void")
mkPRVar <- externalVar dph_PArray (fsLit "mkPR")
combines <- mapM (externalVar dph_PArray)
[mkFastString ("combine" ++ show i ++ "PA#")
- | i <- [2..mAX_NDP_COMBINE]]
- let combinePAVars = listArray (2, mAX_NDP_COMBINE) combines
+ | i <- [2..mAX_DPH_COMBINE]]
+ let combinePAVars = listArray (2, mAX_DPH_COMBINE) combines
liftingContext <- liftM (\u -> mkSysLocal (fsLit "lc") u intPrimTy)
newUnique
initBuiltinVars :: Builtins -> DsM [(Var, Var)]
-initBuiltinVars (Builtins { dphModules = modules })
+initBuiltinVars (Builtins { dphModules = mods })
= do
- uvars <- zipWithM externalVar (map ($ modules) umods) ufs
- vvars <- zipWithM externalVar (map ($ modules) vmods) vfs
- cvars <- zipWithM externalVar (map ($ modules) cmods) cfs
+ 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
+ (umods, ufs, vmods, vfs) = unzip4 (preludeVars mods)
- (cons, cmods, cfs) = unzip3 preludeDataCons
+ (cons, cmods, cfs) = unzip3 (preludeDataCons mods)
defaultDataConWorkers :: [DataCon]
defaultDataConWorkers = [trueDataCon, falseDataCon, unitDataCon]
-preludeDataCons :: [(DataCon, Modules -> Module, FastString)]
-preludeDataCons
+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, Modules -> Module, FastString)]
-preludeVars
+preludeVars :: Modules -> [(Module, FastString, Module, FastString)]
+preludeVars (Modules { dph_Combinators = dph_Combinators
+ , dph_PArray = dph_PArray
+ , dph_Prelude_Int = dph_Prelude_Int
+ , dph_Prelude_Double = dph_Prelude_Double
+ , dph_Prelude_Bool = dph_Prelude_Bool
+ , dph_Prelude_PArr = dph_Prelude_PArr
+ })
= [
- mk (const gHC_PARR) (fsLit "mapP") dph_Combinators (fsLit "mapPA")
- , mk (const gHC_PARR) (fsLit "zipWithP") dph_Combinators (fsLit "zipWithPA")
- , mk (const gHC_PARR) (fsLit "zipP") dph_Combinators (fsLit "zipPA")
- , mk (const gHC_PARR) (fsLit "unzipP") dph_Combinators (fsLit "unzipPA")
- , mk (const gHC_PARR) (fsLit "filterP") dph_Combinators (fsLit "filterPA")
- , mk (const gHC_PARR) (fsLit "lengthP") dph_Combinators (fsLit "lengthPA")
- , mk (const gHC_PARR) (fsLit "replicateP") dph_Combinators (fsLit "replicatePA")
- , mk (const gHC_PARR) (fsLit "!:") dph_Combinators (fsLit "indexPA")
- , mk (const gHC_PARR) (fsLit "crossMapP") dph_Combinators (fsLit "crossMapPA")
- , mk (const gHC_PARR) (fsLit "singletonP") dph_Combinators (fsLit "singletonPA")
- , mk (const gHC_PARR) (fsLit "concatP") dph_Combinators (fsLit "concatPA")
- , mk (const gHC_PARR) (fsLit "+:+") dph_Combinators (fsLit "appPA")
- , mk (const gHC_PARR) (fsLit "emptyP") dph_PArray (fsLit "emptyPA")
+ 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 (fsLit "plus") dph_Prelude_Int (fsLit "plusV")
, mk dph_Prelude_Int (fsLit "minus") dph_Prelude_Int (fsLit "minusV")
where
mk name mod fs = (name, mod, fs)
- tups = map mk_tup [2..mAX_NDP_PROD]
+ tups = map mk_tup [2..mAX_DPH_PROD]
mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
(dph_Instances mods)
(mkFastString $ "dPA_" ++ show n)
, mk doubleTyConName (dph_Instances mods) (fsLit "dPR_Double")
]
- ++ map mk_sum [2..mAX_NDP_SUM]
- ++ map mk_prod [2..mAX_NDP_PROD]
+ ++ map mk_sum [2..mAX_DPH_SUM]
+ ++ map mk_prod [2..mAX_DPH_PROD]
where
mk name mod fs = (name, mod, fs)
externalTyCon :: Module -> FastString -> DsM TyCon
externalTyCon mod fs
- = dsLookupTyCon =<< lookupOrig mod (mkOccNameFS tcName fs)
+ = dsLookupTyCon =<< lookupOrig mod (mkTcOccFS fs)
externalType :: Module -> FastString -> DsM Type
externalType mod fs
| Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
= liftM Just
$ dsLookupTyCon =<< lookupOrig (dph_Unboxed mods)
- (mkOccName tcName $ "PArray" ++ suffix)
+ (mkTcOcc $ "PArray" ++ suffix)
| otherwise = return Nothing