diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 3b0cd48b3e5a545d6a84380affd4d02756095685..721325d33f3cc9c3cbd397c829b7cbbd1b836b6f 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -137,7 +137,8 @@ mkIPName :: Unique -> OccName -> Name
mkIPName uniq occ
= Name { n_uniq = uniq,
n_sort = Local,
- n_occ = mkIPOcc occ,
+ n_occ = occ,
+ -- ZZ is this an appropriate provinence?
n_prov = SystemProv }
------------------------- Wired in names -------------------------
@@ -240,6 +241,7 @@ all_toplev_ids_visible =
opt_EnsureSplittableC -- Splitting requires visiblilty
\end{code}
+
\begin{code}
setNameProvenance :: Name -> Provenance -> Name
-- setNameProvenance used to only change the provenance of
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index c530956aa95325dbaf171e0a85cedbc1135d6096..ba980eed74ecc84c6d5c9a7083bdfe940a4f1e8b 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -213,7 +213,7 @@ pprExpr e = pprDeeper (ppr_expr e)
pprBinds b = pprDeeper (ppr b)
ppr_expr (HsVar v) = ppr v
-ppr_expr (HsIPVar v) = char '?' <> ppr v
+ppr_expr (HsIPVar v) = {- char '?' <> -} ppr v
ppr_expr (HsLit lit) = ppr lit
ppr_expr (HsLitOut lit _) = ppr lit
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 0f70df5f42057c5b0557927d8205e13a88c0a847..c9637b41d71854f9b26e1daac794ae901c3b26dd 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -52,6 +52,8 @@ data HsType name
| MonoTupleTy [HsType name] -- Element types (length gives arity)
Bool -- boxed?
+ | MonoIParamTy name (HsType name)
+
-- these next two are only used in interfaces
| MonoDictTy name -- Class
[HsType name]
@@ -135,7 +137,7 @@ pprHsPred :: (Outputable name) => HsPred name -> SDoc
pprHsPred (HsPClass clas tys)
= ppr clas <+> hsep (map pprParendHsType tys)
pprHsPred (HsPIParam n ty)
- = hsep [char '?' <> ppr n, text "::", ppr ty]
+ = hsep [{- char '?' <> -} ppr n, text "::", ppr ty]
\end{code}
\begin{code}
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index e882a37c138097053b709d5f6020d3213fdbe6cc..056880e2a1686cecd2874c3076faa28755c8aa1a 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -50,7 +50,7 @@ import Class ( Class, classExtraBigSig )
import FieldLabel ( fieldLabelName, fieldLabelType )
import Type ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType,
deNoteType, classesToPreds,
- Type, ThetaType
+ Type, ThetaType, PredType(..), ClassContext
)
import PprType
@@ -578,15 +578,21 @@ ppr_decl_context :: ThetaType -> SDoc
ppr_decl_context [] = empty
ppr_decl_context theta = pprIfaceTheta theta <+> ptext SLIT(" =>")
-ppr_decl_class_context :: [(Class,[Type])] -> SDoc
+ppr_decl_class_context :: ClassContext -> SDoc
ppr_decl_class_context [] = empty
ppr_decl_class_context ctxt = pprIfaceClasses ctxt <+> ptext SLIT(" =>")
pprIfaceTheta :: ThetaType -> SDoc -- Use braces rather than parens in interface files
pprIfaceTheta [] = empty
-pprIfaceTheta theta = braces (hsep (punctuate comma [pprPred p | p <- theta]))
+pprIfaceTheta theta = braces (hsep (punctuate comma [pprIfacePred p | p <- theta]))
-pprIfaceClasses :: [(Class,[Type])] -> SDoc
+-- ZZ - not sure who uses this - i.e. whether IParams really show up or not
+-- (it's not used to print normal value signatures)
+pprIfacePred :: PredType -> SDoc
+pprIfacePred (Class clas tys) = pprConstraint clas tys
+pprIfacePred (IParam n ty) = char '?' <> ppr n <+> ptext SLIT("::") <+> ppr ty
+
+pprIfaceClasses :: ClassContext -> SDoc
pprIfaceClasses [] = empty
pprIfaceClasses theta = braces (hsep (punctuate comma [pprConstraint c tys | (c,tys) <- theta]))
\end{code}
diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 8dae914d657e3ebd176779f6eab146c147acb802..7d74bedfc86ae0b3ede29c1bd073ab2cc20ccff3 100644
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -595,7 +595,7 @@ lexToken cont glaexts buf =
cont (ITunknown "\NUL") (stepOn buf)
'?'# | flag glaexts && is_lower (lookAhead# buf 1#) ->
- lex_ip cont (setCurrentPos# buf 1#)
+ lex_ip cont (stepOn buf)
c | is_digit c -> lex_num cont glaexts 0 buf
| is_symbol c -> lex_sym cont buf
| is_upper c -> lex_con cont glaexts buf
diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index b410fee27ccc172d708fc1f8f761b1978e068ad4..c396e3f936d25dbcdb9279ba8f2ce8aa164a08a6 100644
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -136,13 +136,21 @@ checkInstType t
checkContext :: RdrNameHsType -> P RdrNameContext
checkContext (MonoTupleTy ts True)
- = mapP (\t -> checkAssertion t []) ts `thenP` \cs ->
- returnP (map (uncurry HsPClass) cs)
+ = mapP (\t -> checkPred t []) ts `thenP` \ps ->
+ returnP ps
checkContext (MonoTyVar t) -- empty contexts are allowed
| t == unitTyCon_RDR = returnP []
checkContext t
- = checkAssertion t [] `thenP` \(c,ts) ->
- returnP [HsPClass c ts]
+ = checkPred t [] `thenP` \p ->
+ returnP [p]
+
+checkPred :: RdrNameHsType -> [RdrNameHsType]
+ -> P (HsPred RdrName)
+checkPred (MonoTyVar t) args@(_:_) | not (isRdrTyVar t)
+ = returnP (HsPClass t args)
+checkPred (MonoTyApp l r) args = checkPred l (r:args)
+checkPred (MonoIParamTy n ty) [] = returnP (HsPIParam n ty)
+checkPred _ _ = parseError "Illegal class assertion"
checkAssertion :: RdrNameHsType -> [RdrNameHsType]
-> P (HsClassAssertion RdrName)
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 759c2dcff12937321d66ac1ea0d126f021d50570..a94edffad1fd2b77c9b03a308aa685665edd7e9a 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.19 2000/01/28 20:52:39 lewie Exp $
+$Id: Parser.y,v 1.20 2000/02/09 18:32:10 lewie Exp $
Haskell grammar.
@@ -35,6 +35,7 @@ import GlaExts
{-
-----------------------------------------------------------------------------
Conflicts: 14 shift/reduce
+ (note: it's currently 21 -- JRL, 31/1/2000)
8 for abiguity in 'if x then y else z + 1'
(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
@@ -85,7 +86,6 @@ Conflicts: 14 shift/reduce
'then' { ITthen }
'type' { ITtype }
'where' { ITwhere }
- 'with' { ITwith }
'_scc_' { ITscc }
'forall' { ITforall } -- GHC extension keywords
@@ -94,6 +94,7 @@ Conflicts: 14 shift/reduce
'label' { ITlabel }
'dynamic' { ITdynamic }
'unsafe' { ITunsafe }
+ 'with' { ITwith }
'stdcall' { ITstdcallconv }
'ccall' { ITccallconv }
'_ccall_' { ITccall (False, False, False) }
@@ -174,7 +175,8 @@ Conflicts: 14 shift/reduce
QCONID { ITqconid $$ }
QVARSYM { ITqvarsym $$ }
QCONSYM { ITqconsym $$ }
- IPVARID { ITipvarid $$ }
+
+ IPVARID { ITipvarid $$ } -- GHC extension
PRAGMA { ITpragma $$ }
@@ -489,6 +491,7 @@ type :: { RdrNameHsType }
btype :: { RdrNameHsType }
: btype atype { MonoTyApp $1 $2 }
+ | IPVARID '::' type { MonoIParamTy (mkSrcUnqual ipName $1) $3 }
| atype { $1 }
atype :: { RdrNameHsType }
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 950fe54abc686998a525d0168a35ce7d246edc27..2d3239aceb04d5c7e6d0e87c97d587810cdcd724 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -145,7 +145,8 @@ import Ratio ( (%) )
QCONID { ITqconid $$ }
QVARSYM { ITqvarsym $$ }
QCONSYM { ITqconsym $$ }
- IPVARID { ITipvarid $$ }
+
+ IPVARID { ITipvarid $$ } -- GHC extension
PRAGMA { ITpragma $$ }
@@ -452,6 +453,7 @@ atype : qtc_name { MonoTyVar $1 }
| '(#' types0 '#)' { MonoTupleTy $2 False{-unboxed-} }
| '[' type ']' { MonoListTy $2 }
| '{' qcls_name atypes '}' { MonoDictTy $2 $3 }
+ | '{' IPVARID '::' type '}' { MonoIParamTy (mkSysUnqual ipName $2) $4 }
| '(' type ')' { $2 }
-- This one is dealt with via qtc_name
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index ad7df46f936ab114f83eb518a2a33bea59697afd..9f8e3435efff16ba490459b06b4acda8c1288f88 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -25,10 +25,11 @@ module Inst (
lookupInst, lookupSimpleInst, LookupInstResult(..),
- isDict, isTyVarDict, isStdClassTyVarDict, isMethodFor, notFunDep,
+ isDict, isClassDict, isTyVarDict, isStdClassTyVarDict, isMethodFor, notFunDep,
instBindingRequired, instCanBeGeneralised,
- zonkInst, zonkFunDeps, zonkTvFunDeps, instToId, instToIdBndr,
+ zonkInst, zonkInsts, zonkFunDeps, zonkTvFunDeps,
+ instToId, instToIdBndr, ipToId,
InstOrigin(..), InstLoc, pprInstLoc
) where
@@ -52,7 +53,8 @@ import Class ( classInstEnv, Class )
import FunDeps ( instantiateFdClassTys )
import Id ( Id, idFreeTyVars, idType, mkUserLocal, mkSysLocal )
import PrelInfo ( isStandardClass, isCcallishClass, isNoDictClass )
-import Name ( OccName, Name, mkDictOcc, mkMethodOcc, getOccName, nameUnique )
+import Name ( OccName, Name, mkDictOcc, mkMethodOcc, mkIPOcc,
+ getOccName, nameUnique )
import PprType ( pprPred )
import InstEnv ( InstEnv, lookupInstEnv )
import SrcLoc ( SrcLoc )
@@ -310,8 +312,11 @@ Predicates
~~~~~~~~~~
\begin{code}
isDict :: Inst -> Bool
-isDict (Dict _ (Class _ _) _) = True
+isDict (Dict _ _ _) = True
isDict other = False
+isClassDict :: Inst -> Bool
+isClassDict (Dict _ (Class _ _) _) = True
+isClassDict other = False
isMethodFor :: TcIdSet -> Inst -> Bool
isMethodFor ids (Method uniq id tys _ _ loc)
@@ -485,9 +490,7 @@ instToIdBndr :: Inst -> TcId
instToIdBndr (Dict u (Class clas ty) (_,loc,_))
= mkUserLocal (mkDictOcc (getOccName clas)) u (mkDictTy clas ty) loc
instToIdBndr (Dict u (IParam n ty) (_,loc,_))
--- = mkUserLocal (mkIPOcc (getOccName n)) u (mkPredTy (IParam n ty)) loc
- = mkUserLocal (getOccName n) (nameUnique n) (mkPredTy (IParam n ty)) loc
--- = mkVanillaId n ty
+ = ipToId n ty loc
instToIdBndr (Method u id tys theta tau (_,loc,_))
= mkUserLocal (mkMethodOcc (getOccName id)) u tau loc
@@ -497,6 +500,9 @@ instToIdBndr (LitInst u list ty loc)
instToIdBndr (FunDep clas fds _)
= panic "FunDep escaped!!!"
+
+ipToId n ty loc
+ = mkUserLocal (mkIPOcc (getOccName n)) (nameUnique n) (mkPredTy (IParam n ty)) loc
\end{code}
@@ -539,6 +545,8 @@ zonkInst (FunDep clas fds loc)
= zonkFunDeps fds `thenNF_Tc` \ fds' ->
returnNF_Tc (FunDep clas fds' loc)
+zonkInsts insts = mapNF_Tc zonkInst insts
+
zonkFunDeps fds = mapNF_Tc zonkFd fds
where
zonkFd (ts1, ts2)
diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index ec5a59280f6905e7f57de20db0d96d8e8ddf907e..d9dc3a2adc4787943eeb56ab3b3a96e6fa11bb2d 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -291,7 +291,7 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
-- SIMPLIFY THE LIE
tcExtendGlobalTyVars tyvars_not_to_gen (
let ips = getIPsOfLIE lie_req in
- if null real_tyvars_to_gen_list && null ips then
+ if null real_tyvars_to_gen_list && (null ips || not is_unrestricted) then
-- No polymorphism, and no IPs, so no need to simplify context
returnTc (lie_req, EmptyMonoBinds, [])
else
diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 273d25954efb02aec4b4f59aa47d2920346fd05a..b125752c8de9f921eed3f545a4a9236277ecb9e5 100644
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -25,7 +25,7 @@ import Inst ( Inst, InstOrigin(..), OverloadedLit(..),
lieToList, listToLIE, tyVarsOfLIE, zonkLIE,
newOverloadedLit, newMethod, newIPDict,
instOverloadedFun, newDicts, newClassDicts,
- partitionLIEbyMeth, getIPsOfLIE
+ partitionLIEbyMeth, getIPsOfLIE, instToId, ipToId
)
import TcBinds ( tcBindsAndThen )
import TcEnv ( tcInstId,
@@ -200,10 +200,11 @@ tcMonoExpr (HsVar name) res_ty
\begin{code}
tcMonoExpr (HsIPVar name) res_ty
+ -- ZZ What's the `id' used for here...
= let id = mkVanillaId name res_ty in
tcGetInstLoc (OccurrenceOf id) `thenNF_Tc` \ loc ->
newIPDict name res_ty loc `thenNF_Tc` \ ip ->
- returnNF_Tc (HsIPVar id, unitLIE ip)
+ returnNF_Tc (HsIPVar (instToId ip), unitLIE ip)
\end{code}
%************************************************************************
@@ -746,7 +747,8 @@ tcMonoExpr (HsWith expr binds) res_ty
tcIPBinds ((name, expr) : binds)
= newTyVarTy_OpenKind `thenTc` \ ty ->
- let id = mkVanillaId name ty in
+ tcGetSrcLoc `thenTc` \ loc ->
+ let id = ipToId name ty loc in
tcMonoExpr expr ty `thenTc` \ (expr', lie) ->
zonkTcType ty `thenTc` \ ty' ->
tcIPBinds binds `thenTc` \ (binds', types, lie2) ->
diff --git a/ghc/compiler/typecheck/TcImprove.lhs b/ghc/compiler/typecheck/TcImprove.lhs
index 0cacae3299e3e32ceb8ddcee1db46860d0319e29..dfe35ddb2255e0e58a71f3697a7e60811ffa5de6 100644
--- a/ghc/compiler/typecheck/TcImprove.lhs
+++ b/ghc/compiler/typecheck/TcImprove.lhs
@@ -12,7 +12,7 @@ import TcMonad
import TcType ( zonkTcType, zonkTcTypes )
import TcUnify ( unifyTauTyLists )
import Inst ( Inst, LookupInstResult(..),
- lookupInst, isDict, getFunDepsOfLIE, getIPsOfLIE,
+ lookupInst, getFunDepsOfLIE, getIPsOfLIE,
zonkLIE, zonkFunDeps {- for debugging -} )
import InstEnv ( InstEnv ) -- Reqd for 4.02; InstEnv is a synonym, and
-- 4.02 doesn't "see" it soon enough
diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs
index 4fe0e3e33a38a54c06552a66d7781078410c36a4..ce5d681219eabab29d2ebb5d3ee0f25552e0a35f 100644
--- a/ghc/compiler/typecheck/TcMonoType.lhs
+++ b/ghc/compiler/typecheck/TcMonoType.lhs
@@ -198,13 +198,13 @@ tc_type_kind (HsForAllTy (Just tv_names) context ty)
-- f :: forall a. Num a => (# a->a, a->a #)
-- And we want these to get through the type checker
check ct@(Class c tys) | ambiguous = failWithTc (ambigErr (c,tys) tau)
- | otherwise = returnTc ()
where ct_vars = tyVarsOfTypes tys
forall_tyvars = map varName in_scope_vars
tau_vars = tyVarsOfType tau
ambig ct_var = (varName ct_var `elem` forall_tyvars) &&
not (ct_var `elemUFM` tau_vars)
ambiguous = foldUFM ((||) . ambig) False ct_vars
+ check _ = returnTc ()
in
mapTc check theta `thenTc_`
returnTc (body_kind, mkSigmaTy tyvars theta tau)
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 104fc9d3fe7b5fff64ee660f9b9c77b6ec0656b0..4de479c0c858fb7f930280366fd75168b6988578 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -132,7 +132,8 @@ import TcHsSyn ( TcExpr, TcId,
import TcMonad
import Inst ( lookupInst, lookupSimpleInst, LookupInstResult(..),
tyVarsOfInst, tyVarsOfInsts,
- isDict, isStdClassTyVarDict, isMethodFor, notFunDep,
+ isDict, isClassDict, isStdClassTyVarDict,
+ isMethodFor, notFunDep,
instToId, instBindingRequired, instCanBeGeneralised,
newDictFromOld,
getDictClassTys, getIPs,
@@ -220,8 +221,6 @@ tcSimplify str local_tvs wanted_lie
(irreds', bad_guys) = partition (isEmptyVarSet . ambig_tv_fn) irreds
ambig_tv_fn dict = tyVarsOfInst dict `minusVarSet` avail_tvs
in
- -- pprTrace "tcS" (ppr (frees, irreds')) $
- -- pprTrace "tcS bad" (ppr bad_guys) $
addAmbigErrs ambig_tv_fn bad_guys `thenNF_Tc_`
@@ -288,7 +287,7 @@ tcSimplifyAndCheck str local_tvs given_lie wanted_lie
givens = lieToList given_lie
-- see comment on wanteds in tcSimplify
wanteds = filter notFunDep (lieToList wanted_lie)
- given_dicts = filter isDict givens
+ given_dicts = filter isClassDict givens
try_me inst
-- Does not constrain a local tyvar
@@ -722,7 +721,7 @@ addSuperClasses :: Avails s -> Inst -> NF_TcM s (Avails s)
-- Invariant: the Inst is already in Avails.
addSuperClasses avails dict
- | not (isDict dict)
+ | not (isClassDict dict)
= returnNF_Tc avails
| otherwise -- It is a dictionary
@@ -1217,7 +1216,7 @@ addNoInstanceErr str givens dict
ptext SLIT("Probable cause:") <+>
vcat [sep [ptext SLIT("missing") <+> quotes (pprInst tidy_dict),
ptext SLIT("in") <+> str],
- if isDict dict && all_tyvars then empty else
+ if isClassDict dict && all_tyvars then empty else
ptext SLIT("or missing instance declaration for") <+> quotes (pprInst tidy_dict)]
)
where
diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs
index 24294bacaad9c8c5ef2f6caded213097f84bde95..db54a7da6011ec6b26ab03752dbaee29d1415139 100644
--- a/ghc/compiler/types/PprType.lhs
+++ b/ghc/compiler/types/PprType.lhs
@@ -69,7 +69,7 @@ pprParendKind = pprParendType
pprPred :: PredType -> SDoc
pprPred (Class clas tys) = pprConstraint clas tys
-pprPred (IParam n ty) = ppr n <+> ppr ty
+pprPred (IParam n ty) = hsep [ppr n, ptext SLIT("::"), ppr ty]
pprConstraint :: Class -> [Type] -> SDoc
pprConstraint clas tys = ppr clas <+> hsep (map (pprParendType) tys)
@@ -189,7 +189,7 @@ ppr_ty env ctxt_prec ty@(ForAllTy _ _)
<+> ptext SLIT("=>")
ppr_pred (Class clas tys) = ppr clas <+> hsep (map (ppr_ty env tYCON_PREC) tys)
- ppr_pred (IParam n ty) = hsep [char '?' <> ppr n, text "::",
+ ppr_pred (IParam n ty) = hsep [{- char '?' <> -} ppr n, text "::",
ppr_ty env tYCON_PREC ty]
ppr_ty env ctxt_prec (FunTy ty1 ty2)
diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
index a060f63dac5ca2dcebf456fb2c9b5469950e69a0..cba55fbcb6bfe9aa92332ad5fdd4a5ad35eb1c01 100644
--- a/ghc/compiler/types/Type.lhs
+++ b/ghc/compiler/types/Type.lhs
@@ -89,7 +89,7 @@ import Var ( TyVar, IdOrTyVar, UVar,
import VarEnv
import VarSet
-import Name ( Name, NamedThing(..), mkLocalName, tidyOccName,
+import Name ( Name, NamedThing(..), mkLocalName, tidyOccName
)
import NameSet
import Class ( classTyCon, Class )
@@ -864,7 +864,7 @@ tidyType env@(tidy_env, subst) ty
go_note note@(FTVNote ftvs) = note -- No need to tidy the free tyvars
go_note note@(UsgNote _) = note -- Usage annotation is already tidy
go_note note@(UsgForAll _) = note -- Uvar binder is already tidy
- go_note note@(IPNote _) = note -- IP is already tidy
+ go_note (IPNote n) = IPNote (tidyIPName n)
tidyTypes env tys = map (tidyType env) tys
\end{code}
@@ -888,6 +888,12 @@ tidyTopType :: Type -> Type
tidyTopType ty = tidyType emptyTidyEnv ty
\end{code}
+\begin{code}
+tidyIPName :: Name -> Name
+tidyIPName name
+ = mkLocalName (getUnique name) (getOccName name) noSrcLoc
+\end{code}
+
%************************************************************************
%* *