[project @ 2000-12-07 08:29:05 by simonpj]

Tidy up functional dependencies slightly

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 533058f..9c2401e 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -51,7 +51,7 @@ import Type           ( mkTyVarTy, tyVarsOfTypes, mkTyConApp,
                          mkPredTy, mkForAllTy, isUnLiftedType, 
                          isUnboxedType, unboxedTypeKind, boxedTypeKind, openTypeKind
                        )
-import FunDeps         ( tyVarFunDep, oclose )
+import FunDeps         ( oclose )
 import Var             ( tyVarKind )
 import VarSet
 import Bag
@@ -557,8 +557,8 @@ getTyVarsToGen is_unrestricted mono_id_tys lie
          -- Then we should generalise over b too; otherwise it will be
          -- reported as ambiguous.
        zonkFunDeps fds         `thenNF_Tc` \ fds' ->
-       let tvFundep        = tyVarFunDep fds'
-           extended_tyvars = oclose tvFundep body_tyvars
+       let 
+           extended_tyvars = oclose fds' body_tyvars
        in
        returnNF_Tc (emptyVarSet, extended_tyvars)
     else

diff --git a/ghc/compiler/typecheck/TcImprove.lhs b/ghc/compiler/typecheck/TcImprove.lhs
index 6c7c51c..9cc500f 100644 (file)
--- a/ghc/compiler/typecheck/TcImprove.lhs
+++ b/ghc/compiler/typecheck/TcImprove.lhs
@@ -126,7 +126,5 @@ zonkUnifyTys free ts1 ts2
   = mapTc zonkTcType ts1 `thenTc` \ ts1' ->
     mapTc zonkTcType ts2 `thenTc` \ ts2' ->
     -- pprTrace "zMT" (ppr (ts1', free, ts2')) $
-    case unifyTyListsX free ts2' ts1' of
-      Just subst -> returnTc (Just subst)
-      Nothing    -> returnTc Nothing
+    returnTc (unifyTyListsX free ts2' ts1')
 \end{code}

diff --git a/ghc/compiler/types/FunDeps.lhs b/ghc/compiler/types/FunDeps.lhs
index 7c6a27c..25659e0 100644 (file)
--- a/ghc/compiler/types/FunDeps.lhs
+++ b/ghc/compiler/types/FunDeps.lhs
@@ -9,7 +9,6 @@ It's better to read it as: "if we know these, then we're going to know these"
 module FunDeps (
        oclose,
         instantiateFdClassTys,
-        tyVarFunDep,
         pprFundeps
     ) where
 
@@ -22,17 +21,19 @@ import Outputable   ( Outputable, SDoc, interppSP, ptext, empty, hsep, punctuate,
 import UniqSet
 import VarSet
 import VarEnv
-import Unique          ( Uniquable )
 import Util            ( zipEqual )
 \end{code}
 
 
 \begin{code}
-oclose :: Uniquable a => [FunDep a] -> UniqSet a -> UniqSet a
+oclose :: [FunDep Type] -> TyVarSet -> TyVarSet
 -- (oclose fds tvs) closes the set of type variables tvs, 
 -- wrt the functional dependencies fds.  The result is a superset
 -- of the argument set.
 --
+-- In fact the functional dependencies are *instantiated*, so we
+-- first have to extract the free vars.
+--
 -- For example,
 --     oclose [a -> b] {a}     = {a,b}
 --     oclose [a b -> c] {a}   = {a}
@@ -40,10 +41,16 @@ oclose :: Uniquable a => [FunDep a] -> UniqSet a -> UniqSet a
 -- If all of the things on the left of an arrow are in the set, add
 -- the things on the right of that arrow.
 
-oclose fds vs =
-    case oclose1 fds vs of
-      (vs', False) -> vs'
-      (vs', True)  -> oclose fds vs'
+oclose fds vs
+  = go vs
+  where
+    go vs = case oclose1 tv_fds vs of
+               (vs', False) -> vs'
+               (vs', True)  -> go vs'
+
+    tv_fds  :: [FunDep TyVar]
+    tv_fds  = [(get_tvs xs, get_tvs ys) | (xs, ys) <- fds]
+    get_tvs = varSetElems . tyVarsOfTypes
 
 oclose1 [] vs = (vs, False)
 oclose1 (fd@(ls, rs):fds) vs =
@@ -74,11 +81,6 @@ instantiateFdClassTys clas tys
     env       = mkVarEnv (zipEqual "instantiateFdClassTys" tyvars tys)
     lookup tv = lookupVarEnv_NF env tv
 
-tyVarFunDep :: [FunDep Type] -> [FunDep TyVar]
-tyVarFunDep fdtys 
-  = [(getTyvars xs, getTyvars ys) | (xs, ys) <- fdtys]
-  where 
-    getTyvars = varSetElems . tyVarsOfTypes
 
 pprFundeps :: Outputable a => [FunDep a] -> SDoc
 pprFundeps [] = empty