- return $ tidyTypes term
- where
- tidyTypes = foldTerm idTermFold {
- fTerm = \ty dc hval tt -> Term (tidy ty) dc hval tt,
- fSuspension = \ct mb_ty hval n ->
- Suspension ct (fmap tidy mb_ty) hval n
- }
- tidy ty = tidyType (emptyTidyOccEnv, tidyVarEnv ty) ty
- tidyVarEnv ty = mkVarEnv$
- [ (v, setTyVarName v (tyVarName tv))
- | (tv,v) <- zip alphaTyVars vars]
- where vars = varSetElems$ tyVarsOfType ty
+ let term' = tidyTypes term
+ return term'
+ where allvars = nub . foldTerm TermFold {
+ fTerm = \ty _ _ tt ->
+ varEnvElts(tyVarsOfType ty) ++ concat tt,
+ fSuspension = \_ mb_ty _ _ ->
+ maybe [] (varEnvElts . tyVarsOfType) mb_ty,
+ fPrim = \ _ _ -> [] }
+ tidyTypes term = let
+ go = foldTerm idTermFold {
+ fTerm = \ty dc hval tt ->
+ Term (tidy ty) dc hval tt,
+ fSuspension = \ct mb_ty hval n ->
+ Suspension ct (fmap tidy mb_ty) hval n }
+ tidy ty = tidyType (emptyTidyOccEnv, tidyVarEnv) ty
+ tidyVarEnv = mkVarEnv$
+ [ (v, alpha_tv `setTyVarUnique` varUnique v)
+ | (alpha_tv,v) <- zip alphaTyVars (allvars term)]
+ in go term