, prTyCon :: TyCon
, prDataCon :: DataCon
, parrayIntPrimTyCon :: TyCon
+ , parrayBoolPrimTyCon :: TyCon
, voidTyCon :: TyCon
, wrapTyCon :: TyCon
, sumTyCons :: Array Int TyCon
, applyClosurePVar :: Var
, replicatePAIntPrimVar :: Var
, upToPAIntPrimVar :: Var
+ , selectPAIntPrimVar :: Var
+ , truesPABoolPrimVar :: Var
, lengthPAVar :: Var
, replicatePAVar :: Var
, emptyPAVar :: Var
- -- , packPAVar :: Var
+ , packPAVar :: Var
-- , combinePAVar :: Var
, liftingContext :: Var
}
prTyCon <- externalTyCon nDP_PARRAY FSLIT("PR")
let [prDataCon] = tyConDataCons prTyCon
parrayIntPrimTyCon <- externalTyCon nDP_PRIM FSLIT("PArray_Int#")
+ parrayBoolPrimTyCon <- externalTyCon nDP_PRIM FSLIT("PArray_Bool#")
closureTyCon <- externalTyCon nDP_CLOSURE FSLIT(":->")
voidTyCon <- externalTyCon nDP_REPR FSLIT("Void")
applyClosurePVar <- externalVar nDP_CLOSURE FSLIT("$:^")
replicatePAIntPrimVar <- externalVar nDP_PRIM FSLIT("replicatePA_Int#")
upToPAIntPrimVar <- externalVar nDP_PRIM FSLIT("upToPA_Int#")
+ selectPAIntPrimVar <- externalVar nDP_PRIM FSLIT("selectPA_Int#")
+ truesPABoolPrimVar <- externalVar nDP_PRIM FSLIT("truesPA_Bool#")
lengthPAVar <- externalVar nDP_PARRAY FSLIT("lengthPA")
replicatePAVar <- externalVar nDP_PARRAY FSLIT("replicatePA")
emptyPAVar <- externalVar nDP_PARRAY FSLIT("emptyPA")
- -- packPAVar <- dsLookupGlobalId packPAName
+ packPAVar <- externalVar nDP_PARRAY FSLIT("packPA")
-- combinePAVar <- dsLookupGlobalId combinePAName
liftingContext <- liftM (\u -> mkSysLocal FSLIT("lc") u intPrimTy)
, prTyCon = prTyCon
, prDataCon = prDataCon
, parrayIntPrimTyCon = parrayIntPrimTyCon
+ , parrayBoolPrimTyCon = parrayBoolPrimTyCon
, voidTyCon = voidTyCon
, wrapTyCon = wrapTyCon
, sumTyCons = sumTyCons
, applyClosurePVar = applyClosurePVar
, replicatePAIntPrimVar = replicatePAIntPrimVar
, upToPAIntPrimVar = upToPAIntPrimVar
+ , selectPAIntPrimVar = selectPAIntPrimVar
+ , truesPABoolPrimVar = truesPABoolPrimVar
, lengthPAVar = lengthPAVar
, replicatePAVar = replicatePAVar
, emptyPAVar = emptyPAVar
- -- , packPAVar = packPAVar
+ , packPAVar = packPAVar
-- , combinePAVar = combinePAVar
, liftingContext = liftingContext
}
parrayReprTyCon, parrayReprDataCon, mkVScrut,
prDFunOfTyCon,
paDictArgType, paDictOfType, paDFunType,
- paMethod, mkPR, lengthPA, replicatePA, emptyPA, liftPA,
+ paMethod, mkPR, lengthPA, replicatePA, emptyPA, packPA, liftPA,
polyAbstract, polyApply, polyVApply,
hoistBinding, hoistExpr, hoistPolyVExpr, takeHoisted,
buildClosure, buildClosures,
pa_length = (lengthPAVar, "lengthPA")
pa_replicate = (replicatePAVar, "replicatePA")
pa_empty = (emptyPAVar, "emptyPA")
+pa_pack = (packPAVar, "packPA")
paMethod :: PAMethod -> Type -> VM CoreExpr
paMethod (method, name) ty
emptyPA :: Type -> VM CoreExpr
emptyPA = paMethod pa_empty
+packPA :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> VM CoreExpr
+packPA ty xs len sel = liftM (`mkApps` [len, sel])
+ (paMethod pa_pack ty)
+
liftPA :: CoreExpr -> VM CoreExpr
liftPA x
= do