[project @ 2001-02-28 11:48:34 by simonpj]

[ghc-hetmet.git] / ghc / compiler / specialise / Rules.lhs

diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs
index efe68cd..8d8819a 100644 (file)
--- a/ghc/compiler/specialise/Rules.lhs
+++ b/ghc/compiler/specialise/Rules.lhs
@@ -5,8 +5,10 @@
 
 \begin{code}
 module Rules (
-       RuleBase, emptyRuleBase, extendRuleBase, extendRuleBaseList, pprRuleBase,
-       addRuleBaseFVs,
+       RuleBase, emptyRuleBase, 
+       extendRuleBase, extendRuleBaseList, addRuleBaseFVs, 
+       ruleBaseIds, ruleBaseFVs,
+       pprRuleBase,
 
         lookupRule, addRule, addIdSpecialisations
     ) where
@@ -23,10 +25,8 @@ import Subst         ( Subst, InScopeSet, mkInScopeSet, lookupSubst, extendSubst,
                          substEnv, setSubstEnv, emptySubst, isInScope,
                          bindSubstList, unBindSubstList, substInScope, uniqAway
                        )
-import Id              ( Id, idUnfolding, zapLamIdInfo, 
-                         idSpecialisation, setIdSpecialisation
-                       ) 
-import Var             ( isTyVar, isId )
+import Id              ( Id, idUnfolding, idSpecialisation, setIdSpecialisation ) 
+import Var             ( isId )
 import VarSet
 import VarEnv
 import Type            ( mkTyVarTy )
@@ -360,7 +360,7 @@ bind vs1 vs2 matcher tpl_vars kont subst
 
 ----------------------------------------
 match_ty ty1 ty2 tpl_vars kont subst
-  = case Unify.match ty1 ty2 tpl_vars Just (substEnv subst) of
+  = case Unify.match False {- for now: KSW 2000-10 -} ty1 ty2 tpl_vars Just (substEnv subst) of
        Nothing    -> match_fail
        Just senv' -> kont (setSubstEnv subst senv') 
 
@@ -423,13 +423,12 @@ insertRule rules new_rule@(Rule _ tpl_vars tpl_args _)
 
     new_is_more_specific rule = maybeToBool (matchRule tpl_var_set rule tpl_args)
 
-addIdSpecialisations :: Id -> [([CoreBndr], [CoreExpr], CoreExpr)] -> Id
-addIdSpecialisations id spec_stuff
-  = setIdSpecialisation id new_rules
+addIdSpecialisations :: Id -> [CoreRule] -> Id
+addIdSpecialisations id rules
+  = setIdSpecialisation id new_specs
   where
-    rule_name = _PK_ ("SPEC " ++ showSDoc (ppr id))
-    new_rules = foldr add (idSpecialisation id) spec_stuff
-    add (vars, args, rhs) rules = addRule rules id (Rule rule_name vars args rhs)
+    new_specs = foldr add (idSpecialisation id) rules
+    add rule rules = addRule rules id rule
 \end{code}
 
 
@@ -465,6 +464,9 @@ data RuleBase = RuleBase
        -- This representation is a bit cute, and I wonder if we should
        -- change it to use (IdEnv CoreRule) which seems a bit more natural
 
+ruleBaseIds (RuleBase ids _) = ids
+ruleBaseFVs (RuleBase _ fvs) = fvs
+
 emptyRuleBase = RuleBase emptyVarSet emptyVarSet
 
 addRuleBaseFVs :: RuleBase -> IdSet -> RuleBase