X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcoreSyn%2FCoreSubst.lhs;fp=ghc%2Fcompiler%2FcoreSyn%2FCoreSubst.lhs;h=a4b86eadf35b3c94f024009e28b2cdb57b403bb3;hb=dd313897eb9a14bcc7b81f97e4f2292c30039efd;hp=2de0390af0a9bf79d4bbc336dbd33ba5a6d66b52;hpb=89d6434a7ddb499c5b09eb3c70437782b0dcd501;p=ghc-hetmet.git

diff --git a/ghc/compiler/coreSyn/CoreSubst.lhs b/ghc/compiler/coreSyn/CoreSubst.lhs
index 2de0390..a4b86ea 100644
--- a/ghc/compiler/coreSyn/CoreSubst.lhs
+++ b/ghc/compiler/coreSyn/CoreSubst.lhs
@@ -8,7 +8,7 @@ module CoreSubst (
 	-- Substitution stuff
 	Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
 
-	substTy, substExpr, substRules, substWorker,
+	substTy, substExpr, substSpec, substWorker,
 	lookupIdSubst, lookupTvSubst, 
 
 	emptySubst, mkEmptySubst, mkSubst, substInScope, isEmptySubst, 
@@ -24,8 +24,7 @@ module CoreSubst (
 #include "HsVersions.h"
 
 import CoreSyn		( Expr(..), Bind(..), Note(..), CoreExpr,
-			  CoreRules(..), CoreRule(..), 
-			  isEmptyCoreRules, seqRules, hasUnfolding, noUnfolding
+			  CoreRule(..), hasUnfolding, noUnfolding
 			)
 import CoreFVs		( exprFreeVars )
 import CoreUtils	( exprIsTrivial )
@@ -36,8 +35,8 @@ import VarSet
 import VarEnv
 import Var		( setVarUnique, isId )
 import Id		( idType, setIdType, maybeModifyIdInfo, isLocalId )
-import IdInfo		( IdInfo, specInfo, setSpecInfo, 
-			  unfoldingInfo, setUnfoldingInfo,
+import IdInfo		( IdInfo, SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
+			  unfoldingInfo, setUnfoldingInfo, seqSpecInfo,
 			  WorkerInfo(..), workerExists, workerInfo, setWorkerInfo, WorkerInfo
 			)
 import Unique		( Unique )
@@ -339,13 +338,13 @@ substIdInfo :: Subst -> IdInfo -> Maybe IdInfo
 -- Always zaps the unfolding, to save substitution work
 substIdInfo  subst info
   | nothing_to_do = Nothing
-  | otherwise     = Just (info `setSpecInfo`   	  substRules  subst old_rules
+  | otherwise     = Just (info `setSpecInfo`   	  substSpec  subst old_rules
 			       `setWorkerInfo` 	  substWorker subst old_wrkr
 			       `setUnfoldingInfo` noUnfolding)
   where
     old_rules 	  = specInfo info
     old_wrkr  	  = workerInfo info
-    nothing_to_do = isEmptyCoreRules old_rules &&
+    nothing_to_do = isEmptySpecInfo old_rules &&
 		    not (workerExists old_wrkr) &&
 		    not (hasUnfolding (unfoldingInfo info))
     
@@ -366,22 +365,23 @@ substWorker subst (HasWorker w a)
 				--  via postInlineUnconditionally, hence warning)
 
 ------------------
-substRules :: Subst -> CoreRules -> CoreRules
+substSpec :: Subst -> SpecInfo -> SpecInfo
 
-substRules subst rules
- | isEmptySubst subst = rules
-substRules subst (Rules rules rhs_fvs)
-  = seqRules new_rules `seq` new_rules
+substSpec subst spec@(SpecInfo rules rhs_fvs)
+  | isEmptySubst subst
+  = spec
+  | otherwise
+  = seqSpecInfo new_rules `seq` new_rules
   where
-    new_rules = Rules (map do_subst rules) (substVarSet subst rhs_fvs)
+    new_rules = SpecInfo (map do_subst rules) (substVarSet subst rhs_fvs)
 
-    do_subst rule@(BuiltinRule _ _) = rule
-    do_subst (Rule name act tpl_vars lhs_args rhs)
-	= Rule name act tpl_vars' 
-	       (map (substExpr subst') lhs_args)
-	       (substExpr subst' rhs)
+    do_subst rule@(BuiltinRule {}) = rule
+    do_subst rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
+	= rule { ru_bndrs = bndrs',
+		 ru_args  = map (substExpr subst') args,
+		 ru_rhs   = substExpr subst' rhs }
 	where
-	  (subst', tpl_vars') = substBndrs subst tpl_vars
+	  (subst', bndrs') = substBndrs subst bndrs
 
 ------------------
 substVarSet subst fvs