From: simonpj <unknown>
Date: Thu, 7 Dec 2000 08:29:05 +0000 (+0000)
Subject: [project @ 2000-12-07 08:29:05 by simonpj]
X-Git-Tag: Approximately_9120_patches~3182
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=730ca873dd0ff2a45f932d0ffdc5f30572848937;p=ghc-hetmet.git

[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
--- 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
--- 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
--- 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