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, pprFundeps) where
   5
   6 #include "HsVersions.h"
   7
   8 import Class            (classTvsFds)
   9 import Outputable       (interppSP, ptext, empty, hsep, punctuate, comma)
  10 import UniqSet          (elementOfUniqSet, addOneToUniqSet )
  11 import List             (elemIndex)
  12
  13 oclose fds vs =
  14     case oclose1 fds vs of
  15       (vs', False) -> vs'
  16       (vs', True) -> oclose fds vs'
  17
  18 oclose1 [] vs = (vs, False)
  19 oclose1 (fd@(ls, rs):fds) vs =
  20     if osubset ls vs then
  21         (vs'', b1 || b2)
  22     else
  23         vs'b1
  24     where
  25         vs'b1@(vs', b1) = oclose1 fds vs
  26         (vs'', b2) = ounion rs vs'
  27
  28 osubset [] vs = True
  29 osubset (u:us) vs = if u `elementOfUniqSet` vs then osubset us vs else False
  30
  31 ounion [] ys = (ys, False)
  32 ounion (x:xs) ys =
  33     if x `elementOfUniqSet` ys then (ys', b) else (addOneToUniqSet ys' x, True)
  34     where
  35         (ys', b) = ounion xs ys
  36
  37 instantiateFdClassTys clas ts =
  38     map (lookupInstFundep tyvars ts) fundeps
  39     where
  40         (tyvars, fundeps) = classTvsFds clas
  41         lookupInstFundep tyvars ts (us, vs) =
  42             (lookupInstTys tyvars ts us, lookupInstTys tyvars ts vs)
  43 lookupInstTys tyvars ts = map (lookupInstTy tyvars ts)
  44 lookupInstTy tyvars ts u = ts !! i
  45     where Just i = elemIndex u tyvars
  46
  47 pprFundeps [] = empty
  48 pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
  49
  50 ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs]
  51
  52 \end{code}