X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSubst.lhs;h=acf17e3c124d29a4562df5ce734de2754dabed7f;hp=047e6c337b2553dbc187bbf14f0e27901af943bb;hb=a1fae73a83665d7b9134509e80d34ff69a009cc7;hpb=75f9f3559b9959f067c893ae3f7c89da7fd18813

diff --git a/compiler/coreSyn/CoreSubst.lhs b/compiler/coreSyn/CoreSubst.lhs
index 047e6c3..acf17e3 100644
--- a/compiler/coreSyn/CoreSubst.lhs
+++ b/compiler/coreSyn/CoreSubst.lhs
@@ -692,16 +692,16 @@ substRule :: Subst -> (Name -> Name) -> CoreRule -> CoreRule
 --    - Rules for *imported* Ids never change ru_fn
 --    - Rules for *local* Ids are in the IdInfo for that Id,
 --      and the ru_fn field is simply replaced by the new name 
---	of the Id
+--      of the Id
 substRule _ _ rule@(BuiltinRule {}) = rule
 substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
                                        , ru_fn = fn_name, ru_rhs = rhs
                                        , ru_local = is_local })
   = rule { ru_bndrs = bndrs', 
-	   ru_fn    = if is_local 
-                      	then subst_ru_fn fn_name 
-                      	else fn_name,
-	   ru_args  = map (substExpr (text "subst-rule" <+> ppr fn_name) subst') args,
+           ru_fn    = if is_local 
+                        then subst_ru_fn fn_name 
+                        else fn_name,
+           ru_args  = map (substExpr (text "subst-rule" <+> ppr fn_name) subst') args,
            ru_rhs   = simpleOptExprWith subst' rhs }
            -- Do simple optimisation on RHS, in case substitution lets
            -- you improve it.  The real simplifier never gets to look at it.
@@ -709,13 +709,22 @@ substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args
     (subst', bndrs') = substBndrs subst bndrs
 
 ------------------
+substVects :: Subst -> [CoreVect] -> [CoreVect]
+substVects subst = map (substVect subst)
+
+------------------
+substVect :: Subst -> CoreVect -> CoreVect
+substVect _subst (Vect v Nothing)    = Vect v Nothing
+substVect subst  (Vect v (Just rhs)) = Vect v (Just (simpleOptExprWith subst rhs))
+
+------------------
 substVarSet :: Subst -> VarSet -> VarSet
 substVarSet subst fvs
   = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
   where
     subst_fv subst fv 
-	| isId fv   = exprFreeVars (lookupIdSubst (text "substVarSet") subst fv)
-	| otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
+        | isId fv   = exprFreeVars (lookupIdSubst (text "substVarSet") subst fv)
+        | otherwise = Type.tyVarsOfType (lookupTvSubst subst fv)
 \end{code}
 
 Note [Worker inlining]
@@ -766,15 +775,16 @@ simpleOptExprWith :: Subst -> InExpr -> OutExpr
 simpleOptExprWith subst expr = simple_opt_expr subst (occurAnalyseExpr expr)
 
 ----------------------
-simpleOptPgm :: DynFlags -> [CoreBind] -> [CoreRule] -> IO ([CoreBind], [CoreRule])
-simpleOptPgm dflags binds rules
+simpleOptPgm :: DynFlags -> [CoreBind] -> [CoreRule] -> [CoreVect] 
+             -> IO ([CoreBind], [CoreRule], [CoreVect])
+simpleOptPgm dflags binds rules vects
   = do { dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
-		       (pprCoreBindings occ_anald_binds);
+                       (pprCoreBindings occ_anald_binds);
 
-       ; return (reverse binds', substRulesForImportedIds subst' rules) }
+       ; return (reverse binds', substRulesForImportedIds subst' rules, substVects subst' vects) }
   where
     occ_anald_binds  = occurAnalysePgm Nothing {- No rules active -}
-                                       rules binds
+                                       rules vects binds
     (subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds
                        
     do_one (subst, binds') bind