X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fvectorise%2FVectUtils.hs;h=a540b4d10c20102fa5c609d376e032ce696cb45d;hb=7c737416e30137e7053b4bcd0fdd563f07fa43b0;hp=3e6143c3985abd225d1f73246b251bd098766008;hpb=821585f5641b4f9033336aaa0ba90c44f06d8373;p=ghc-hetmet.git

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index 3e6143c..a540b4d 100644
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -346,6 +346,19 @@ takeHoisted
       setGEnv $ env { global_bindings = [] }
       return $ global_bindings env
 
+boxExpr :: Type -> VExpr -> VM VExpr
+boxExpr ty (vexpr, lexpr)
+  | Just (tycon, []) <- splitTyConApp_maybe ty
+  , isUnLiftedTyCon tycon
+  = do
+      r <- lookupBoxedTyCon tycon
+      case r of
+        Just tycon' -> let [dc] = tyConDataCons tycon'
+                       in
+                       return (mkConApp dc [vexpr], lexpr)
+        Nothing     -> return (vexpr, lexpr)
+
+
 mkClosure :: Type -> Type -> Type -> VExpr -> VExpr -> VM VExpr
 mkClosure arg_ty res_ty env_ty (vfn,lfn) (venv,lenv)
   = do