Refactoring

[ghc-hetmet.git] / compiler / vectorise / VectUtils.hs

diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index 8cb0a11..05102c0 100644 (file)
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -5,7 +5,7 @@ module VectUtils (
   splitClosureTy,
 
   TyConRepr(..), mkTyConRepr,
-  mkToPRepr, mkToArrPRepr, mkFromPRepr, mkFromArrPRepr,
+  mkToArrPRepr, mkFromArrPRepr,
   mkPADictType, mkPArrayType, mkPReprType,
 
   parrayCoerce, parrayReprTyCon, parrayReprDataCon, mkVScrut,
@@ -41,6 +41,7 @@ import BasicTypes         ( Boxity(..) )
 
 import Outputable
 import FastString
+import Maybes             ( orElse )
 
 import Data.List             ( zipWith4 )
 import Control.Monad         ( liftM, liftM2, zipWithM_ )
@@ -126,13 +127,15 @@ mkBuiltinTyConApps1 get_tc dft tys
     mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
 
 data TyConRepr = TyConRepr {
-                   repr_tyvars      :: [TyVar]
-                 , repr_tys         :: [[Type]]
-
-                 , repr_prod_tycons :: [Maybe TyCon]
-                 , repr_prod_tys    :: [Type]
-                 , repr_sum_tycon   :: Maybe TyCon
-                 , repr_type        :: Type
+                   repr_tyvars         :: [TyVar]
+                 , repr_tys            :: [[Type]]
+
+                 , repr_prod_tycons    :: [Maybe TyCon]
+                 , repr_prod_data_cons :: [Maybe DataCon]
+                 , repr_prod_tys       :: [Type]
+                 , repr_sum_tycon      :: Maybe TyCon
+                 , repr_sum_data_cons  :: [DataCon]
+                 , repr_type           :: Type
                  }
 
 mkTyConRepr :: TyCon -> VM TyConRepr
@@ -143,13 +146,15 @@ mkTyConRepr vect_tc
       sum_tycon   <- mk_tycon sumTyCon prod_tys
 
       return $ TyConRepr {
-                 repr_tyvars      = tyvars
-               , repr_tys         = rep_tys
-
-               , repr_prod_tycons = prod_tycons
-               , repr_prod_tys    = prod_tys
-               , repr_sum_tycon   = sum_tycon
-               , repr_type        = mk_tc_app_maybe sum_tycon prod_tys
+                 repr_tyvars         = tyvars
+               , repr_tys            = rep_tys
+
+               , repr_prod_tycons    = prod_tycons
+               , repr_prod_data_cons = map (fmap mk_single_datacon) prod_tycons
+               , repr_prod_tys       = prod_tys
+               , repr_sum_tycon      = sum_tycon
+               , repr_sum_data_cons  = fmap tyConDataCons sum_tycon `orElse` []
+               , repr_type           = mk_tc_app_maybe sum_tycon prod_tys
                }
   where
     tyvars = tyConTyVars vect_tc
@@ -161,35 +166,12 @@ mkTyConRepr vect_tc
       | otherwise = return Nothing
       where n = length tys
 
+    mk_single_datacon tc | [dc] <- tyConDataCons tc = dc
+
     mk_tc_app_maybe Nothing   []   = unitTy
     mk_tc_app_maybe Nothing   [ty] = ty
     mk_tc_app_maybe (Just tc) tys  = mkTyConApp tc tys
 
-mkToPRepr :: TyConRepr -> [[CoreExpr]] -> [CoreExpr]
-mkToPRepr (TyConRepr {
-             repr_tys         = repr_tys
-           , repr_prod_tycons = prod_tycons
-           , repr_prod_tys    = prod_tys
-           , repr_sum_tycon   = repr_sum_tycon
-           })
-  = mk_sum . zipWith3 mk_prod prod_tycons repr_tys
-  where
-    Just sum_tycon = repr_sum_tycon
-
-    mk_sum []     = [Var unitDataConId]
-    mk_sum [expr] = [expr]
-    mk_sum exprs  = zipWith (mk_alt prod_tys) (tyConDataCons sum_tycon) exprs
-
-    mk_alt tys dc expr = mk_con_app dc tys [expr]
-
-    mk_prod _         _   []     = Var unitDataConId
-    mk_prod _         _   [expr] = expr
-    mk_prod (Just tc) tys exprs  = mk_con_app dc tys exprs
-      where
-        [dc] = tyConDataCons tc
-
-    mk_con_app dc tys exprs = mkConApp dc (map Type tys ++ exprs)
-
 mkToArrPRepr :: CoreExpr -> CoreExpr -> [[CoreExpr]] -> VM CoreExpr
 mkToArrPRepr len sel ess
   = do
@@ -219,39 +201,6 @@ mkToArrPRepr len sel ess
 
       liftM fst (mk_sum =<< mapM mk_prod ess)
 
-mkFromPRepr :: CoreExpr -> Type -> [([Var], CoreExpr)] -> VM CoreExpr
-mkFromPRepr scrut res_ty alts
-  = do
-      sum_tcs  <- builtins sumTyCon
-      prod_tcs <- builtins prodTyCon
-
-      let un_sum expr ty [(vars, res)] = un_prod expr ty vars res
-          un_sum expr ty bs
-            = do
-                ps     <- mapM (newLocalVar FSLIT("p")) tys
-                bodies <- sequence
-                        $ zipWith4 un_prod (map Var ps) tys vars rs
-                return . Case expr (mkWildId ty) res_ty
-                       $ zipWith3 mk_alt sum_dcs ps bodies
-            where
-              (vars, rs) = unzip bs
-              tys        = splitFixedTyConApp sum_tc ty
-              sum_tc     = sum_tcs $ length bs
-              sum_dcs    = tyConDataCons sum_tc
-
-              mk_alt dc p body = (DataAlt dc, [p], body)
-
-          un_prod expr ty []    r = return r
-          un_prod expr ty [var] r = return $ Let (NonRec var expr) r
-          un_prod expr ty vars  r
-            = return $ Case expr (mkWildId ty) res_ty
-                       [(DataAlt prod_dc, vars, r)]
-            where
-              prod_tc   = prod_tcs $ length vars
-              [prod_dc] = tyConDataCons prod_tc
-
-      un_sum scrut (exprType scrut) alts
-
 mkFromArrPRepr :: CoreExpr -> Type -> Var -> Var -> [[Var]] -> CoreExpr
                -> VM CoreExpr
 mkFromArrPRepr scrut res_ty len sel vars res