splitClosureTy,
mkPADictType, mkPArrayType,
paDictArgType, paDictOfType,
+ paMethod, lengthPA, replicatePA, emptyPA,
lookupPArrayFamInst,
- hoistExpr
+ hoistExpr, takeHoisted
) where
#include "HsVersions.h"
dicts <- mapM paDictOfType tys
return $ mkApps (mkTyApps dfun tys) dicts
+paMethod :: (Builtins -> Var) -> Type -> VM CoreExpr
+paMethod method ty
+ = do
+ fn <- builtin method
+ dict <- paDictOfType ty
+ return $ mkApps (Var fn) [Type ty, dict]
+
+lengthPA :: CoreExpr -> VM CoreExpr
+lengthPA x = liftM (`App` x) (paMethod lengthPAVar (exprType x))
+
+replicatePA :: CoreExpr -> CoreExpr -> VM CoreExpr
+replicatePA len x = liftM (`mkApps` [len,x])
+ (paMethod replicatePAVar (exprType x))
+
+emptyPA :: Type -> VM CoreExpr
+emptyPA = paMethod emptyPAVar
+
lookupPArrayFamInst :: Type -> VM (TyCon, [Type])
lookupPArrayFamInst ty = builtin parrayTyCon >>= (`lookupFamInst` [ty])
env { global_bindings = (var, expr) : global_bindings env }
return var
+takeHoisted :: VM [(Var, CoreExpr)]
+takeHoisted
+ = do
+ env <- readGEnv id
+ setGEnv $ env { global_bindings = [] }
+ return $ global_bindings env
+