, prTyCon :: TyCon
, prDataCon :: DataCon
, parrayIntPrimTyCon :: TyCon
+ , voidTyCon :: TyCon
, wrapTyCon :: TyCon
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
+ , voidVar :: Var
, mkPRVar :: Var
, mkClosureVar :: Var
, applyClosureVar :: Var
prodTyCon :: Int -> Builtins -> TyCon
prodTyCon n bi
+ | n == 0 = voidTyCon bi
| n == 1 = wrapTyCon bi
- | n >= 0 && n <= mAX_NDP_PROD = tupleTyCon Boxed n
+ | n >= 2 && n <= mAX_NDP_PROD = tupleTyCon Boxed n
| otherwise = pprPanic "prodTyCon" (ppr n)
initBuiltins :: DsM Builtins
parrayIntPrimTyCon <- dsLookupTyCon parrayIntPrimTyConName
closureTyCon <- dsLookupTyCon closureTyConName
+ voidTyCon <- lookupExternalTyCon nDP_REPR FSLIT("Void")
wrapTyCon <- lookupExternalTyCon nDP_REPR FSLIT("Wrap")
sum_tcs <- mapM (lookupExternalTyCon nDP_REPR)
[mkFastString ("Sum" ++ show i) | i <- [2..mAX_NDP_SUM]]
let sumTyCons = listArray (2, mAX_NDP_SUM) sum_tcs
+ voidVar <- lookupExternalVar nDP_REPR FSLIT("void")
mkPRVar <- dsLookupGlobalId mkPRName
mkClosureVar <- dsLookupGlobalId mkClosureName
applyClosureVar <- dsLookupGlobalId applyClosureName
, prTyCon = prTyCon
, prDataCon = prDataCon
, parrayIntPrimTyCon = parrayIntPrimTyCon
+ , voidTyCon = voidTyCon
, wrapTyCon = wrapTyCon
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
+ , voidVar = voidVar
, mkPRVar = mkPRVar
, mkClosureVar = mkClosureVar
, applyClosureVar = applyClosureVar
where
(tcs, mods, fss) = unzip3 ps
-initBuiltinPAs = initBuiltinDicts builtinPAs
+initBuiltinPAs = initBuiltinDicts . builtinPAs
-builtinPAs :: [(Name, Module, FastString)]
-builtinPAs = [
- mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo")
- , mk unitTyConName nDP_INSTANCES FSLIT("dPA_Unit")
+builtinPAs :: Builtins -> [(Name, Module, FastString)]
+builtinPAs bi
+ = [
+ mk closureTyConName nDP_CLOSURE FSLIT("dPA_Clo")
+ , mk (tyConName $ voidTyCon bi) nDP_REPR FSLIT("dPA_Void")
+ , mk unitTyConName nDP_INSTANCES FSLIT("dPA_Unit")
- , mk intTyConName nDP_INSTANCES FSLIT("dPA_Int")
- ]
- ++ tups
+ , mk intTyConName nDP_INSTANCES FSLIT("dPA_Int")
+ ]
+ ++ tups
where
mk name mod fs = (name, mod, fs)
builtinPRs bi =
[
mk (tyConName unitTyCon) nDP_REPR FSLIT("dPR_Unit")
+ , mk (tyConName $ voidTyCon bi) nDP_REPR FSLIT("dPR_Void")
, mk (tyConName $ wrapTyCon bi) nDP_REPR FSLIT("dPR_Wrap")
, mk closureTyConName nDP_CLOSURE FSLIT("dPR_Clo")
| IdRepr Type
+ | VoidRepr {
+ void_tycon :: TyCon
+ , void_bottom :: CoreExpr
+ }
+
+mkVoid :: VM Repr
+mkVoid = do
+ tycon <- builtin voidTyCon
+ var <- builtin voidVar
+ return $ VoidRepr {
+ void_tycon = tycon
+ , void_bottom = Var var
+ }
+
mkProduct :: [Type] -> VM Repr
mkProduct tys
= do
arity = length tys
mkSubProduct :: [Type] -> VM Repr
+mkSubProduct [] = mkVoid
mkSubProduct [ty] = return $ IdRepr ty
mkSubProduct tys = mkProduct tys
reprType (SumRepr { sum_tycon = tycon, sum_components = reprs })
= mkTyConApp tycon (map reprType reprs)
reprType (IdRepr ty) = ty
+reprType (VoidRepr { void_tycon = tycon }) = mkTyConApp tycon []
arrReprType :: Repr -> VM Type
arrReprType = mkPArrayType . reprType
return [intPrimTy, mkTyConApp int_arr [], mkTyConApp int_arr []]
arrShapeTys (ProdRepr {}) = return [intPrimTy]
arrShapeTys (IdRepr _) = return []
+arrShapeTys (VoidRepr {}) = return [intPrimTy]
arrShapeVars :: Repr -> VM [Var]
arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr
up <- builtin upToPAIntPrimVar
return [len, Var rep `mkApps` [len, tag], Var up `App` len]
replicateShape (IdRepr _) _ _ = return []
+replicateShape (VoidRepr {}) len _ = return [len]
-arrReprElemTys :: Repr -> [[Type]]
+arrReprElemTys :: Repr -> VM [[Type]]
arrReprElemTys (SumRepr { sum_components = prods })
- = map arrProdElemTys prods
+ = mapM arrProdElemTys prods
arrReprElemTys prod@(ProdRepr {})
- = [arrProdElemTys prod]
-arrReprElemTys (IdRepr ty) = [[ty]]
+ = do
+ tys <- arrProdElemTys prod
+ return [tys]
+arrReprElemTys (IdRepr ty) = return [[ty]]
+arrReprElemTys (VoidRepr { void_tycon = tycon })
+ = return [[mkTyConApp tycon []]]
arrProdElemTys (ProdRepr { prod_components = [] })
- = [unitTy]
+ = do
+ void <- builtin voidTyCon
+ return [mkTyConApp void []]
arrProdElemTys (ProdRepr { prod_components = tys })
- = tys
-arrProdElemTys (IdRepr ty) = [ty]
+ = return tys
+arrProdElemTys (IdRepr ty) = return [ty]
+arrProdElemTys (VoidRepr { void_tycon = tycon })
+ = return [mkTyConApp tycon []]
arrReprTys :: Repr -> VM [[Type]]
-arrReprTys = mapM (mapM mkPArrayType) . arrReprElemTys
+arrReprTys repr = mapM (mapM mkPArrayType) =<< arrReprElemTys repr
arrReprVars :: Repr -> VM [[Var]]
arrReprVars repr
var <- newLocalVar FSLIT("y") ty
return ([var], Var var)
+ prod_alt (VoidRepr { void_bottom = bottom })
+ = return ([], bottom)
+
+
buildFromPRepr :: Repr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildFromPRepr repr vect_tc prepr_tc _
= do
from_prod (IdRepr _) con expr
= return $ con `App` expr
+ from_prod (VoidRepr {}) con expr
+ = return con
+
buildToArrPRepr :: Repr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildToArrPRepr repr vect_tc prepr_tc arr_tc
= do
. mkConApp data_con
$ map Type tys ++ len : map Var repr_vars
- to_prod [var] (IdRepr ty)
- = return (Var var)
+ to_prod [var] (IdRepr ty) = return (Var var)
+ to_prod [var] (VoidRepr {}) = return (Var var)
+
buildFromArrPRepr :: Repr -> TyCon -> TyCon -> TyCon -> VM CoreExpr
buildFromArrPRepr repr vect_tc prepr_tc arr_tc
body
= return $ Let (NonRec repr_var expr) body
+ from_prod (VoidRepr {})
+ expr
+ shape_vars
+ [repr_var]
+ res_ty
+ body
+ = return $ Let (NonRec repr_var expr) body
+
buildPRDictRepr :: Repr -> VM CoreExpr
+buildPRDictRepr (VoidRepr { void_tycon = tycon })
+ = prDFunOfTyCon tycon
buildPRDictRepr (IdRepr ty) = mkPR ty
buildPRDictRepr (ProdRepr {
prod_components = tys
-> VM ()
vectDataConWorkers repr orig_tc vect_tc arr_tc
= do
+ arr_tys <- arrReprElemTys repr
bs <- sequence
. zipWith3 def_worker (tyConDataCons orig_tc) rep_tys
$ zipWith4 mk_data_con (tyConDataCons vect_tc)
res_ty = mkTyConApp vect_tc var_tys
rep_tys = map dataConRepArgTys $ tyConDataCons vect_tc
- arr_tys = arrReprElemTys repr
[arr_dc] = tyConDataCons arr_tc