Commit f1fa6eb2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Pure refactoring

* Move tidyType and friends from TcType to TypeRep
  (It was always wrong to have it in TcType.)

* Move mkCoAxBranch and friends from FamInst to Coercion

* Move pprCoAxBranch and friends from FamInstEnv to Coercion

No change in functionality, though there might be a little
wibble in error message output, because I combined two different
functions both called pprCoAxBranch!
parent a98e51ec
......@@ -24,7 +24,8 @@ import CoreSyn
import CoreArity
import Id
import IdInfo
import TcType( tidyType, tidyCo, tidyTyVarBndr )
import Type( tidyType, tidyTyVarBndr )
import Coercion( tidyCo )
import Var
import VarEnv
import UniqFM
......
......@@ -22,7 +22,8 @@ import Name
import Var hiding ( varName )
import VarSet
import UniqSupply
import TcType
import Type
import Kind
import GHC
import Outputable
import PprTyThing
......@@ -207,7 +208,7 @@ pprTypeAndContents id = do
dflags <- GHC.getSessionDynFlags
let pefas = gopt Opt_PrintExplicitForalls dflags
pcontents = gopt Opt_PrintBindContents dflags
pprdId = (pprTyThing pefas . AnId) id
pprdId = (PprTyThing.pprTyThing pefas . AnId) id
if pcontents
then do
let depthBound = 100
......
......@@ -63,6 +63,7 @@ import FlagChecker
import Id
import IdInfo
import Demand
import Coercion( tidyCo )
import Annotations
import CoreSyn
import CoreFVs
......
......@@ -31,6 +31,7 @@ import Id
import TyCon
import Coercion( pprCoAxiom )
import HscTypes( tyThingParent_maybe )
import Type( tidyTopType, tidyOpenType )
import TcType
import Name
import VarEnv( emptyTidyEnv )
......
......@@ -29,6 +29,7 @@ import Id
import IdInfo
import InstEnv
import FamInstEnv
import Type ( tidyTopType )
import Demand ( appIsBottom, isTopSig, isBottomingSig )
import BasicTypes
import Name hiding (varName)
......@@ -39,7 +40,6 @@ import PrelNames
import IfaceEnv
import TcEnv
import TcRnMonad
import TcType
import DataCon
import TyCon
import Class
......
......@@ -13,13 +13,13 @@ module FamInst (
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupFamInst, tcLookupDataFamInst,
tcGetFamInstEnvs,
newFamInst,
mkCoAxBranch, mkBranchedCoAxiom, mkSingleCoAxiom
newFamInst
) where
import HscTypes
import FamInstEnv
import InstEnv( roughMatchTcs )
import Coercion( pprCoAxBranchHdr )
import LoadIface
import TypeRep
import TcRnMonad
......@@ -34,9 +34,6 @@ import Util
import Maybes
import TcMType
import TcType
import VarEnv( emptyTidyEnv )
import Type
import SrcLoc
import Name
import Control.Monad
import Data.Map (Map)
......@@ -392,55 +389,3 @@ tcGetFamInstEnvs
= do { eps <- getEps; env <- getGblEnv
; return (eps_fam_inst_env eps, tcg_fam_inst_env env) }
\end{code}
%************************************************************************
%* *
Constructing axioms
These functions are here because tidyType etc
are not available in CoAxiom
%* *
%************************************************************************
Note [Tidy axioms when we build them]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We print out axioms and don't want to print stuff like
F k k a b = ...
Instead we must tidy those kind variables. See Trac #7524.
\begin{code}
mkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars
-> [Type] -- LHS patterns
-> Type -- RHS
-> SrcSpan
-> CoAxBranch
mkCoAxBranch tvs lhs rhs loc
= CoAxBranch { cab_tvs = tvs1
, cab_lhs = tidyTypes env lhs
, cab_rhs = tidyType env rhs
, cab_loc = loc }
where
(env, tvs1) = tidyTyVarBndrs emptyTidyEnv tvs
-- See Note [Tidy axioms when we build them]
mkBranchedCoAxiom :: Name -> TyCon -> [CoAxBranch] -> CoAxiom Branched
mkBranchedCoAxiom ax_name fam_tc branches
= CoAxiom { co_ax_unique = nameUnique ax_name
, co_ax_name = ax_name
, co_ax_tc = fam_tc
, co_ax_implicit = False
, co_ax_branches = toBranchList branches }
mkSingleCoAxiom :: Name -> [TyVar] -> TyCon -> [Type] -> Type -> CoAxiom Unbranched
mkSingleCoAxiom ax_name tvs fam_tc lhs_tys rhs_ty
= CoAxiom { co_ax_unique = nameUnique ax_name
, co_ax_name = ax_name
, co_ax_tc = fam_tc
, co_ax_implicit = False
, co_ax_branches = FirstBranch branch }
where
branch = mkCoAxBranch tvs lhs_tys rhs_ty (getSrcSpan ax_name)
\end{code}
......@@ -26,6 +26,7 @@ import TcEvidence
import TcHsType
import TcPat
import TcMType
import Type( tidyOpenType )
import FunDeps( growThetaTyVars )
import TyCon
import TcType
......
......@@ -28,6 +28,7 @@ import TcGenDeriv
import DataCon
import TyCon
import CoAxiom
import Coercion ( mkSingleCoAxiom )
import FamInstEnv ( FamInst, FamFlavor(..) )
import FamInst
import Module ( Module, moduleName, moduleNameString )
......
......@@ -31,6 +31,7 @@ import TcRnMonad
import TcValidity
import TcMType
import TcType
import Coercion( mkSingleCoAxiom, mkBranchedCoAxiom, pprCoAxBranch )
import BuildTyCl
import Inst
import InstEnv
......
......@@ -42,7 +42,6 @@ import FamInstEnv
import TcAnnotations
import TcBinds
import HeaderInfo ( mkPrelImports )
import TcType ( tidyTopType )
import TcDefaults
import TcEnv
import TcRules
......
......@@ -43,6 +43,7 @@ import TcMType
import TcType
import TysWiredIn( unitTy )
import FamInst
import Coercion( mkCoAxBranch )
import Type
import Kind
import Class
......
......@@ -90,17 +90,6 @@ module TcType (
-- * Finding "exact" (non-dead) type variables
exactTyVarsOfType, exactTyVarsOfTypes,
-- * Tidying type related things up for printing
tidyType, tidyTypes,
tidyOpenType, tidyOpenTypes,
tidyOpenKind,
tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
tidyOpenTyVar, tidyOpenTyVars,
tidyTyVarOcc,
tidyTopType,
tidyKind,
tidyCo, tidyCos,
---------------------------------
-- Foreign import and export
isFFIArgumentTy, -- :: DynFlags -> Safety -> Type -> Bool
......@@ -192,7 +181,6 @@ import ListSetOps
import Outputable
import FastString
import Data.List( mapAccumL )
import Data.IORef
\end{code}
......@@ -520,149 +508,6 @@ pprUserTypeCtxt (DataTyCtxt tc) = ptext (sLit "the context of the data type de
\end{code}
%************************************************************************
%* *
\subsection{TidyType}
%* *
%************************************************************************
Tidying is here becuase it has a special case for FlatSkol
\begin{code}
-- | This tidies up a type for printing in an error message, or in
-- an interface file.
--
-- It doesn't change the uniques at all, just the print names.
tidyTyVarBndrs :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
tidyTyVarBndrs env tvs = mapAccumL tidyTyVarBndr env tvs
tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
tidyTyVarBndr tidy_env@(occ_env, subst) tyvar
= case tidyOccName occ_env occ1 of
(tidy', occ') -> ((tidy', subst'), tyvar')
where
subst' = extendVarEnv subst tyvar tyvar'
tyvar' = setTyVarKind (setTyVarName tyvar name') kind'
name' = tidyNameOcc name occ'
kind' = tidyKind tidy_env (tyVarKind tyvar)
where
name = tyVarName tyvar
occ = getOccName name
-- System Names are for unification variables;
-- when we tidy them we give them a trailing "0" (or 1 etc)
-- so that they don't take precedence for the un-modified name
occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
| otherwise = occ
---------------
tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
-- ^ Add the free 'TyVar's to the env in tidy form,
-- so that we can tidy the type they are free in
tidyFreeTyVars (full_occ_env, var_env) tyvars
= fst (tidyOpenTyVars (full_occ_env, var_env) (varSetElems tyvars))
---------------
tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
---------------
tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
-- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
-- using the environment if one has not already been allocated. See
-- also 'tidyTyVarBndr'
tidyOpenTyVar env@(_, subst) tyvar
= case lookupVarEnv subst tyvar of
Just tyvar' -> (env, tyvar') -- Already substituted
Nothing -> tidyTyVarBndr env tyvar -- Treat it as a binder
---------------
tidyTyVarOcc :: TidyEnv -> TyVar -> TyVar
tidyTyVarOcc (_, subst) tv
= case lookupVarEnv subst tv of
Nothing -> tv
Just tv' -> tv'
---------------
tidyTypes :: TidyEnv -> [Type] -> [Type]
tidyTypes env tys = map (tidyType env) tys
---------------
tidyType :: TidyEnv -> Type -> Type
tidyType _ (LitTy n) = LitTy n
tidyType env (TyVarTy tv) = TyVarTy (tidyTyVarOcc env tv)
tidyType env (TyConApp tycon tys) = let args = tidyTypes env tys
in args `seqList` TyConApp tycon args
tidyType env (AppTy fun arg) = (AppTy $! (tidyType env fun)) $! (tidyType env arg)
tidyType env (FunTy fun arg) = (FunTy $! (tidyType env fun)) $! (tidyType env arg)
tidyType env (ForAllTy tv ty) = ForAllTy tvp $! (tidyType envp ty)
where
(envp, tvp) = tidyTyVarBndr env tv
---------------
-- | Grabs the free type variables, tidies them
-- and then uses 'tidyType' to work over the type itself
tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType env ty
= (env', tidyType (trimmed_occ_env, var_env) ty)
where
(env'@(_, var_env), tvs') = tidyOpenTyVars env (varSetElems (tyVarsOfType ty))
trimmed_occ_env = initTidyOccEnv (map getOccName tvs')
-- The idea here was that we restrict the new TidyEnv to the
-- _free_ vars of the type, so that we don't gratuitously rename
-- the _bound_ variables of the type.
---------------
tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
---------------
-- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
tidyTopType :: Type -> Type
tidyTopType ty = tidyType emptyTidyEnv ty
---------------
tidyOpenKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
tidyOpenKind = tidyOpenType
tidyKind :: TidyEnv -> Kind -> Kind
tidyKind = tidyType
\end{code}
%************************************************************************
%* *
Tidying coercions
%* *
%************************************************************************
\begin{code}
tidyCo :: TidyEnv -> Coercion -> Coercion
tidyCo env@(_, subst) co
= go co
where
go (Refl ty) = Refl (tidyType env ty)
go (TyConAppCo tc cos) = let args = map go cos
in args `seqList` TyConAppCo tc args
go (AppCo co1 co2) = (AppCo $! go co1) $! go co2
go (ForAllCo tv co) = ForAllCo tvp $! (tidyCo envp co)
where
(envp, tvp) = tidyTyVarBndr env tv
go (CoVarCo cv) = case lookupVarEnv subst cv of
Nothing -> CoVarCo cv
Just cv' -> CoVarCo cv'
go (AxiomInstCo con ind cos) = let args = tidyCos env cos
in args `seqList` AxiomInstCo con ind args
go (UnsafeCo ty1 ty2) = (UnsafeCo $! tidyType env ty1) $! tidyType env ty2
go (SymCo co) = SymCo $! go co
go (TransCo co1 co2) = (TransCo $! go co1) $! go co2
go (NthCo d co) = NthCo d $! go co
go (LRCo lr co) = LRCo lr $! go co
go (InstCo co ty) = (InstCo $! go co) $! tidyType env ty
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
tidyCos env = map (tidyCo env)
\end{code}
%************************************************************************
%* *
Finding type family instances
......
......@@ -15,6 +15,9 @@
-- more on System FC and how coercions fit into it.
--
module Coercion (
-- * CoAxioms
mkCoAxBranch, mkBranchedCoAxiom, mkSingleCoAxiom,
-- * Main data type
Coercion(..), Var, CoVar,
LeftOrRight(..), pickLR,
......@@ -69,7 +72,11 @@ module Coercion (
seqCo,
-- * Pretty-printing
pprCo, pprParendCo, pprCoAxiom,
pprCo, pprParendCo,
pprCoAxiom, pprCoAxBranch, pprCoAxBranchHdr,
-- * Tidying
tidyCo, tidyCos,
-- * Other
applyCo
......@@ -87,13 +94,14 @@ import Var
import VarEnv
import VarSet
import Maybes ( orElse )
import Name ( Name, NamedThing(..), nameUnique, getSrcSpan )
import Name ( Name, NamedThing(..), nameUnique, nameModule, getSrcSpan )
import OccName ( parenSymOcc )
import Util
import BasicTypes
import Outputable
import Unique
import Pair
import SrcLoc
import PrelNames ( funTyConKey, eqPrimTyConKey )
import Control.Applicative
import Data.Traversable (traverse, sequenceA)
......@@ -103,6 +111,58 @@ import FastString
import qualified Data.Data as Data hiding ( TyCon )
\end{code}
%************************************************************************
%* *
Constructing axioms
These functions are here because tidyType etc
are not available in CoAxiom
%* *
%************************************************************************
Note [Tidy axioms when we build them]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We print out axioms and don't want to print stuff like
F k k a b = ...
Instead we must tidy those kind variables. See Trac #7524.
\begin{code}
mkCoAxBranch :: [TyVar] -- original, possibly stale, tyvars
-> [Type] -- LHS patterns
-> Type -- RHS
-> SrcSpan
-> CoAxBranch
mkCoAxBranch tvs lhs rhs loc
= CoAxBranch { cab_tvs = tvs1
, cab_lhs = tidyTypes env lhs
, cab_rhs = tidyType env rhs
, cab_loc = loc }
where
(env, tvs1) = tidyTyVarBndrs emptyTidyEnv tvs
-- See Note [Tidy axioms when we build them]
mkBranchedCoAxiom :: Name -> TyCon -> [CoAxBranch] -> CoAxiom Branched
mkBranchedCoAxiom ax_name fam_tc branches
= CoAxiom { co_ax_unique = nameUnique ax_name
, co_ax_name = ax_name
, co_ax_tc = fam_tc
, co_ax_implicit = False
, co_ax_branches = toBranchList branches }
mkSingleCoAxiom :: Name -> [TyVar] -> TyCon -> [Type] -> Type -> CoAxiom Unbranched
mkSingleCoAxiom ax_name tvs fam_tc lhs_tys rhs_ty
= CoAxiom { co_ax_unique = nameUnique ax_name
, co_ax_name = ax_name
, co_ax_tc = fam_tc
, co_ax_implicit = False
, co_ax_branches = FirstBranch branch }
where
branch = mkCoAxBranch tvs lhs_tys rhs_ty (getSrcSpan ax_name)
\end{code}
%************************************************************************
%* *
Coercions
......@@ -386,6 +446,40 @@ coercionSize (LRCo _ co) = 1 + coercionSize co
coercionSize (InstCo co ty) = 1 + coercionSize co + typeSize ty
\end{code}
%************************************************************************
%* *
Tidying coercions
%* *
%************************************************************************
\begin{code}
tidyCo :: TidyEnv -> Coercion -> Coercion
tidyCo env@(_, subst) co
= go co
where
go (Refl ty) = Refl (tidyType env ty)
go (TyConAppCo tc cos) = let args = map go cos
in args `seqList` TyConAppCo tc args
go (AppCo co1 co2) = (AppCo $! go co1) $! go co2
go (ForAllCo tv co) = ForAllCo tvp $! (tidyCo envp co)
where
(envp, tvp) = tidyTyVarBndr env tv
go (CoVarCo cv) = case lookupVarEnv subst cv of
Nothing -> CoVarCo cv
Just cv' -> CoVarCo cv'
go (AxiomInstCo con ind cos) = let args = tidyCos env cos
in args `seqList` AxiomInstCo con ind args
go (UnsafeCo ty1 ty2) = (UnsafeCo $! tidyType env ty1) $! tidyType env ty2
go (SymCo co) = SymCo $! go co
go (TransCo co1 co2) = (TransCo $! go co1) $! go co2
go (NthCo d co) = NthCo d $! go co
go (LRCo lr co) = LRCo lr $! go co
go (InstCo co ty) = (InstCo $! go co) $! tidyType env ty
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
tidyCos env = map (tidyCo env)
\end{code}
%************************************************************************
%* *
Pretty-printing coercions
......@@ -470,10 +564,23 @@ pprCoAxiom ax@(CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
2 (vcat (map (pprCoAxBranch tc) $ fromBranchList branches))
pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc
pprCoAxBranch tc (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs, cab_rhs = rhs })
= ptext (sLit "forall") <+> pprTvBndrs tvs <> dot <+>
pprEqPred (Pair (mkTyConApp tc lhs) rhs)
pprCoAxBranch fam_tc (CoAxBranch { cab_lhs = lhs
, cab_rhs = rhs })
= pprTypeApp fam_tc lhs <+> equals <+> (ppr rhs)
pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
pprCoAxBranchHdr ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_name = name }) index
| CoAxBranch { cab_lhs = tys, cab_loc = loc } <- coAxiomNthBranch ax index
= hang (pprTypeApp fam_tc tys)
2 (ptext (sLit "-- Defined") <+> ppr_loc loc)
where
ppr_loc loc
| isGoodSrcSpan loc
= ptext (sLit "at") <+> ppr (srcSpanStart loc)
| otherwise
= ptext (sLit "in") <+>
quotes (ppr (nameModule name))
\end{code}
%************************************************************************
......
......@@ -8,8 +8,6 @@ FamInstEnv: Type checked family instance declarations
module FamInstEnv (
Branched, Unbranched,
pprCoAxBranch, pprCoAxBranchHdr,
FamInst(..), FamFlavor(..), FamInstBranch(..),
famInstAxiom, famInstBranchRoughMatch,
......@@ -52,7 +50,6 @@ import Outputable
import Maybes
import Util
import FastString
import SrcLoc
\end{code}
......@@ -241,27 +238,6 @@ pprFamFlavor flavor
| isAbstractTyCon tycon -> ptext (sLit "data")
| otherwise -> ptext (sLit "WEIRD") <+> ppr tycon
-- defined here to avoid bad dependencies
pprCoAxBranch :: TyCon -> CoAxBranch -> SDoc
pprCoAxBranch fam_tc (CoAxBranch { cab_lhs = lhs
, cab_rhs = rhs })
= pprTypeApp fam_tc lhs <+> equals <+> (ppr rhs)
pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
pprCoAxBranchHdr ax@(CoAxiom { co_ax_tc = fam_tc, co_ax_name = name }) index
| CoAxBranch { cab_lhs = tys, cab_loc = loc } <- coAxiomNthBranch ax index
= hang (pprTypeApp fam_tc tys)
2 (ptext (sLit "-- Defined") <+> ppr_loc loc)
where
ppr_loc loc
| isGoodSrcSpan loc
= ptext (sLit "at") <+> ppr (srcSpanStart loc)
| otherwise
= ptext (sLit "in") <+>
quotes (ppr (nameModule name))
pprFamInsts :: [FamInst br] -> SDoc
pprFamInsts finsts = vcat (map pprFamInst finsts)
\end{code}
......
......@@ -136,6 +136,16 @@ module Type (
pprTvBndr, pprTvBndrs, pprForAll, pprSigmaType,
pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred,
pprKind, pprParendKind, pprSourceTyCon,
-- * Tidying type related things up for printing
tidyType, tidyTypes,
tidyOpenType, tidyOpenTypes,
tidyOpenKind,
tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
tidyOpenTyVar, tidyOpenTyVars,
tidyTyVarOcc,
tidyTopType,
tidyKind,
) where
#include "HsVersions.h"
......
......@@ -47,6 +47,16 @@ module TypeRep (
-- Free variables
tyVarsOfType, tyVarsOfTypes,
-- * Tidying type related things up for printing
tidyType, tidyTypes,
tidyOpenType, tidyOpenTypes,
tidyOpenKind,
tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
tidyOpenTyVar, tidyOpenTyVars,
tidyTyVarOcc,
tidyTopType,
tidyKind,
-- Substitutions
TvSubst(..), TvSubstEnv
) where
......@@ -75,6 +85,7 @@ import StaticFlags( opt_PprStyle_Debug )
import Util
-- libraries
import Data.List( mapAccumL )
import qualified Data.Data as Data hiding ( TyCon )
\end{code}
......@@ -730,3 +741,111 @@ pprArrowChain p (arg:args) = maybeParen p FunPrec $
sep [arg, sep (map (arrow <+>) args)]
\end{code}
%************************************************************************
%* *
\subsection{TidyType}
%* *
%************************************************************************
Tidying is here becuase it has a special case for FlatSkol
\begin{code}
-- | This tidies up a type for printing in an error message, or in
-- an interface file.
--
-- It doesn't change the uniques at all, just the print names.
tidyTyVarBndrs :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
tidyTyVarBndrs env tvs = mapAccumL tidyTyVarBndr env tvs
tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
tidyTyVarBndr tidy_env@(occ_env, subst) tyvar
= case tidyOccName occ_env occ1 of
(tidy', occ') -> ((tidy', subst'), tyvar')
where
subst' = extendVarEnv subst tyvar tyvar'
tyvar' = setTyVarKind (setTyVarName tyvar name') kind'
name' = tidyNameOcc name occ'
kind' = tidyKind tidy_env (tyVarKind tyvar)
where
name = tyVarName tyvar
occ = getOccName name
-- System Names are for unification variables;
-- when we tidy them we give them a trailing "0" (or 1 etc)
-- so that they don't take precedence for the un-modified name
occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
| otherwise = occ
---------------
tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
-- ^ Add the free 'TyVar's to the env in tidy form,
-- so that we can tidy the type they are free in
tidyFreeTyVars (full_occ_env, var_env) tyvars
= fst (tidyOpenTyVars (full_occ_env, var_env) (varSetElems tyvars))
---------------
tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
---------------
tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
-- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
-- using the environment if one has not already been allocated. See
-- also 'tidyTyVarBndr'
tidyOpenTyVar env@(_, subst) tyvar
= case lookupVarEnv subst tyvar of