-
-{-
-instImprove clas fds =
- pprTrace "class inst env" (ppr (clas, classInstEnv clas)) $
- zonkFunDeps fds `thenTc` \ fds' ->
- pprTrace "lIEFDs" (ppr (clas, fds')) $
- case lookupInstEnvFDs clas fds' of
- Nothing -> returnTc ()
- Just (t_y, s_y) ->
- pprTrace "lIEFDs result" (ppr (t_y, s_y)) $
- unifyTauTyLists t_y s_y
-
-lookupInstEnvFDs clas fds
- = find env
- where
- env = classInstEnv clas
- (ctvs, fds, _, _, _, _) = classExtraBigSig clas
- find [] = Nothing
- find ((tpl_tyvars, tpl, val) : rest)
- = let tplx = concatMap (\us -> thingy tpl us ctvs) (map fst fds)
- tply = concatMap (\vs -> thingy tpl vs ctvs) (map snd fds)
- in
- case matchTys tpl_tyvars tplx tysx of
- Nothing -> find rest
- Just (tenv, leftovers) ->
- let subst = mkSubst (tyVarsOfTypes tys) tenv
- in
- -- this is the list of things that
- -- need to be unified
- Just (map (substTy subst) tply, tysy)
- tysx = concatMap (\us -> thingy tys us ctvs) (map fst fds)
- tysy = concatMap (\vs -> thingy tys vs ctvs) (map snd fds)
- thingy f us ctvs
- = map (f !!) is
- where is = map (\u -> let Just i = elemIndex u ctvs in i) us
--}
-
-{-
- = let (clas, tys) = getDictClassTys dict
- in
- -- first, do instance-based improvement
- instImprove clas tys `thenTc_`
- -- OK, now do pairwise stuff
- mapTc (f clas tys) dicts `thenTc` \ changes ->
- foldrTc (\a b -> returnTc (a || b)) False changes `thenTc` \ changed ->
- allDictPairs f dicts `thenTc` \ rest_changed ->
- returnTc (changed || rest_changed)
--}
-