-
-mkClosure :: Type -> Type -> Type -> VExpr -> VExpr -> VM VExpr
-mkClosure arg_ty res_ty env_ty (vfn,lfn) (venv,lenv)
- = do
- dict <- paDictOfType env_ty
- mkv <- builtin mkClosureVar
- mkl <- builtin mkClosurePVar
- return (Var mkv `mkTyApps` [arg_ty, res_ty, env_ty] `mkApps` [dict, vfn, lfn, venv],
- Var mkl `mkTyApps` [arg_ty, res_ty, env_ty] `mkApps` [dict, vfn, lfn, lenv])
-
--- (clo <x1,...,xn> <f,f^>, aclo (Arr lc xs1 ... xsn) <f,f^>)
--- where
--- f = \env v -> case env of <x1,...,xn> -> e x1 ... xn v
--- f^ = \env v -> case env of Arr l xs1 ... xsn -> e^ l x1 ... xn v
-
-buildClosure :: [TyVar] -> Var -> [VVar] -> VVar -> VExpr -> VM VExpr
-buildClosure tvs lv vars arg body
- = do
- (env_ty, env, bind) <- buildEnv lv vars
- env_bndr <- newLocalVVar FSLIT("env") env_ty
-
- fn <- hoistPolyVExpr FSLIT("fn") tvs
- . mkVLams [env_bndr, arg]
- . bind (vVar env_bndr)
- $ mkVVarApps lv body (vars ++ [arg])
-
- mkClosure arg_ty res_ty env_ty fn env
-
- where
- arg_ty = idType (vectorised arg)
- res_ty = exprType (vectorised body)
-
-
-buildEnv :: Var -> [VVar] -> VM (Type, VExpr, VExpr -> VExpr -> VExpr)
-buildEnv lv vvs
+{-
+boxExpr :: Type -> VExpr -> VM VExpr
+boxExpr ty (vexpr, lexpr)
+ | Just (tycon, []) <- splitTyConApp_maybe ty
+ , isUnLiftedTyCon tycon