ghc/compiler/types/FunDeps.lhs

   1 It's better to read it as: "if we know these, then we're going to know these"
   2
   3 \begin{code}
   4 module FunDeps(oclose, instantiateFdClassTys, tyVarFunDep, pprFundeps) where
   5
   6 #include "HsVersions.h"
   7
   8 import Class            (classTvsFds)
   9 import Type             (tyVarsOfType)
  10 import Outputable       (interppSP, ptext, empty, hsep, punctuate, comma)
  11 import UniqSet          (elementOfUniqSet, addOneToUniqSet,
  12                          uniqSetToList, unionManyUniqSets)
  13 import List             (elemIndex)
  14
  15 oclose fds vs =
  16     case oclose1 fds vs of
  17       (vs', False) -> vs'
  18       (vs', True) -> oclose fds vs'
  19
  20 oclose1 [] vs = (vs, False)
  21 oclose1 (fd@(ls, rs):fds) vs =
  22     if osubset ls vs then
  23         (vs'', b1 || b2)
  24     else
  25         vs'b1
  26     where
  27         vs'b1@(vs', b1) = oclose1 fds vs
  28         (vs'', b2) = ounion rs vs'
  29
  30 osubset [] vs = True
  31 osubset (u:us) vs = if u `elementOfUniqSet` vs then osubset us vs else False
  32
  33 ounion [] ys = (ys, False)
  34 ounion (x:xs) ys =
  35     if x `elementOfUniqSet` ys then (ys', b) else (addOneToUniqSet ys' x, True)
  36     where
  37         (ys', b) = ounion xs ys
  38
  39 instantiateFdClassTys clas ts =
  40     map (lookupInstFundep tyvars ts) fundeps
  41     where
  42         (tyvars, fundeps) = classTvsFds clas
  43         lookupInstFundep tyvars ts (us, vs) =
  44             (lookupInstTys tyvars ts us, lookupInstTys tyvars ts vs)
  45 lookupInstTys tyvars ts = map (lookupInstTy tyvars ts)
  46 lookupInstTy tyvars ts u = ts !! i
  47     where Just i = elemIndex u tyvars
  48
  49 tyVarFunDep fdtys =
  50     map (\(xs, ys) -> (unionMap getTyVars xs, unionMap getTyVars ys)) fdtys
  51     where
  52         getTyVars ty = tyVarsOfType ty
  53         unionMap f xs = uniqSetToList (unionManyUniqSets (map f xs))
  54
  55 pprFundeps [] = empty
  56 pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
  57
  58 ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs]
  59
  60 \end{code}