[project @ 2001-02-28 11:48:34 by simonpj]
[ghc-hetmet.git] / ghc / compiler / specialise / Rules.lhs
index 1f5e74e..8d8819a 100644 (file)
@@ -25,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 )
@@ -362,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') 
 
@@ -425,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}