[project @ 2000-04-10 13:31:00 by simonmar]

[ghc-hetmet.git] / ghc / compiler / types / FunDeps.lhs

diff --git a/ghc/compiler/types/FunDeps.lhs b/ghc/compiler/types/FunDeps.lhs
index ca0de67..d99b53b 100644 (file)
--- a/ghc/compiler/types/FunDeps.lhs
+++ b/ghc/compiler/types/FunDeps.lhs
@@ -1,13 +1,15 @@
 It's better to read it as: "if we know these, then we're going to know these"
 
 \begin{code}
-module FunDeps(oclose, instantiateFdClassTys, pprFundeps) where
+module FunDeps(oclose, instantiateFdClassTys, tyVarFunDep, pprFundeps) where
 
 #include "HsVersions.h"
 
 import Class           (classTvsFds)
+import Type            (tyVarsOfType)
 import Outputable      (interppSP, ptext, empty, hsep, punctuate, comma)
-import UniqSet         (elementOfUniqSet, addOneToUniqSet )
+import UniqSet         (elementOfUniqSet, addOneToUniqSet,
+                        uniqSetToList, unionManyUniqSets)
 import List            (elemIndex)
 
 oclose fds vs =
@@ -44,6 +46,12 @@ lookupInstTys tyvars ts = map (lookupInstTy tyvars ts)
 lookupInstTy tyvars ts u = ts !! i
     where Just i = elemIndex u tyvars
 
+tyVarFunDep fdtys =
+    map (\(xs, ys) -> (unionMap getTyVars xs, unionMap getTyVars ys)) fdtys
+    where
+       getTyVars ty = tyVarsOfType ty
+       unionMap f xs = uniqSetToList (unionManyUniqSets (map f xs))
+
 pprFundeps [] = empty
 pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))