2 % (c) The GRASP/AQUA Project, Glasgow University, 2000
4 \section[FunDeps]{FunDeps - functional dependencies}
6 It's better to read it as: "if we know these, then we're going to know these"
11 instantiateFdClassTys,
16 #include "HsVersions.h"
19 import Class ( Class, FunDep, classTvsFds )
20 import Type ( Type, tyVarsOfTypes )
21 import Outputable ( Outputable, SDoc, interppSP, ptext, empty, hsep, punctuate, comma )
24 import Unique ( Uniquable )
25 import List ( elemIndex )
30 oclose :: Uniquable a => [FunDep a] -> UniqSet a -> UniqSet a
31 -- (oclose fds tvs) closes the set of type variables tvs,
32 -- wrt the functional dependencies fds. The result is a superset
33 -- of the argument set.
36 -- oclose [a -> b] {a} = {a,b}
37 -- oclose [a b -> c] {a} = {a}
38 -- oclose [a b -> c] {a,b} = {a,b,c}
39 -- If all of the things on the left of an arrow are in the set, add
40 -- the things on the right of that arrow.
43 case oclose1 fds vs of
45 (vs', True) -> oclose fds vs'
47 oclose1 [] vs = (vs, False)
48 oclose1 (fd@(ls, rs):fds) vs =
54 vs'b1@(vs', b1) = oclose1 fds vs
55 (vs'', b2) = ounion rs vs'
58 osubset (u:us) vs = if u `elementOfUniqSet` vs then osubset us vs else False
60 ounion [] ys = (ys, False)
62 | x `elementOfUniqSet` ys = (ys', b)
63 | otherwise = (addOneToUniqSet ys' x, True)
65 (ys', b) = ounion xs ys
67 instantiateFdClassTys :: Class -> [a] -> [([a], [a])]
68 -- Get the FDs of the class, and instantiate them
69 instantiateFdClassTys clas ts
70 = map (lookupInstFundep tyvars ts) fundeps
72 (tyvars, fundeps) = classTvsFds clas
73 lookupInstFundep tyvars ts (us, vs)
74 = (lookupInstTys tyvars ts us, lookupInstTys tyvars ts vs)
76 lookupInstTys tyvars ts = map (lookupInstTy tyvars ts)
77 lookupInstTy tyvars ts u = ts !! i
78 where Just i = elemIndex u tyvars
80 tyVarFunDep :: [FunDep Type] -> [FunDep TyVar]
82 = [(varSetElems (tyVarsOfTypes xs), varSetElems (tyVarsOfTypes xs)) | (xs,ys) <- fdtys]
84 pprFundeps :: Outputable a => [FunDep a] -> SDoc
86 pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
88 ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs]