From 38db229302890403037c5de7453299b3538bb404 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 20 Jun 1997 00:34:12 +0000 Subject: [PATCH] [project @ 1997-06-20 00:33:36 by simonpj] More small changes to 2.04 --- ghc/compiler/basicTypes/FieldLabel.lhs | 2 +- ghc/compiler/basicTypes/Id.lhs | 3 ++- ghc/compiler/basicTypes/Name.lhs | 4 ++-- ghc/compiler/basicTypes/Unique.hi-boot | 3 ++- ghc/compiler/basicTypes/Unique.lhs | 15 ++++++++------- ghc/compiler/codeGen/CgBindery.lhs | 3 +-- ghc/compiler/codeGen/CgCase.lhs | 3 +-- ghc/compiler/deSugar/DsGRHSs.lhs | 3 +-- ghc/compiler/hsSyn/HsBinds.lhs | 6 +++--- ghc/compiler/hsSyn/HsTypes.lhs | 2 +- ghc/compiler/nativeGen/MachRegs.lhs | 3 +-- ghc/compiler/prelude/PrelInfo.lhs | 2 +- ghc/compiler/rename/RnEnv.lhs | 4 ++-- ghc/compiler/rename/RnExpr.lhs | 26 ++++++++++++++++++-------- ghc/compiler/rename/RnSource.lhs | 16 ++++++++-------- ghc/compiler/simplCore/SimplCore.lhs | 3 +-- ghc/compiler/simplCore/SimplEnv.lhs | 5 ++--- ghc/compiler/typecheck/TcClassDcl.lhs | 3 +-- ghc/compiler/typecheck/TcEnv.lhs | 2 +- ghc/compiler/typecheck/TcInstDcls.lhs | 21 +++++++++++---------- ghc/compiler/typecheck/TcMonoType.lhs | 3 +-- ghc/compiler/typecheck/TcPat.lhs | 2 +- ghc/compiler/typecheck/TcTyClsDecls.lhs | 3 +-- ghc/compiler/types/Class.lhs | 1 - ghc/compiler/types/PprType.lhs | 5 ++--- ghc/compiler/types/TyCon.lhs | 6 ++---- ghc/compiler/types/TyVar.lhs | 3 +-- ghc/compiler/types/Type.lhs | 1 - ghc/compiler/utils/FastString.lhs | 3 +-- ghc/compiler/utils/Pretty.lhs | 2 +- ghc/compiler/utils/Ubiq.lhi | 1 - ghc/compiler/utils/UniqFM.lhs | 6 +----- ghc/compiler/utils/UniqSet.lhs | 2 +- 33 files changed, 80 insertions(+), 87 deletions(-) diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs index 47725c4..7e03b31 100644 --- a/ghc/compiler/basicTypes/FieldLabel.lhs +++ b/ghc/compiler/basicTypes/FieldLabel.lhs @@ -14,7 +14,7 @@ import Name --( Name{-instance Eq/Outputable-}, nameUnique ) import Type ( SYN_IE(Type) ) import Outputable -import UniqFM ( Uniquable(..) ) +import Unique ( Uniquable(..) ) \end{code} \begin{code} diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs index 0e4aa06..a39e830 100644 --- a/ghc/compiler/basicTypes/Id.lhs +++ b/ghc/compiler/basicTypes/Id.lhs @@ -203,7 +203,8 @@ import UniqFM import UniqSet -- practically all of it import Unique ( getBuiltinUniques, pprUnique, showUnique, incrUnique, - Unique{-instance Ord3-} + Unique{-instance Ord3-}, + Uniquable(..) ) import Outputable ( ifPprDebug, Outputable(..), PprStyle(..) ) import Util {- ( mapAccumL, nOfThem, zipEqual, assoc, diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 198fc42..1750dc7 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -72,10 +72,10 @@ import Pretty import Lex ( isLexSym, isLexConId ) import SrcLoc ( noSrcLoc, SrcLoc ) import Usage ( SYN_IE(UVar), SYN_IE(Usage) ) -import Unique ( pprUnique, showUnique, Unique ) +import Unique ( pprUnique, showUnique, Unique, Uniquable(..) ) import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, isEmptyUniqSet, unionManyUniqSets, minusUniqSet, mkUniqSet, elementOfUniqSet, addListToUniqSet, addOneToUniqSet ) -import UniqFM ( UniqFM, Uniquable(..) ) +import UniqFM ( UniqFM ) import Util --( cmpPString, panic, assertPanic {-, pprTrace ToDo:rm-} ) \end{code} diff --git a/ghc/compiler/basicTypes/Unique.hi-boot b/ghc/compiler/basicTypes/Unique.hi-boot index 237ea4a..2241525 100644 --- a/ghc/compiler/basicTypes/Unique.hi-boot +++ b/ghc/compiler/basicTypes/Unique.hi-boot @@ -1,6 +1,7 @@ _interface_ Unique 1 _exports_ -Unique Unique mkUniqueGrimily; +Unique Unique Uniquable(uniqueOf) mkUniqueGrimily; _declarations_ 1 data Unique; 1 mkUniqueGrimily _:_ GHC.Int# -> Unique.Unique ;; +1 class Uniquable a where {uniqueOf :: a -> Unique}; diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index a25498b..5fa5ad7 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -21,7 +21,7 @@ Haskell). -- UniqSupply module Unique ( - Unique, + Unique, Uniquable(..), u2i, -- hack: used in UniqFM pprUnique, pprUnique10, showUnique, @@ -236,10 +236,6 @@ import PrelBase ( Char(..) ) IMP_Ubiq(){-uitous-} -#if __GLASGOW_HASKELL__ >= 202 -import {-# SOURCE #-} UniqFM ( Uniquable(..) ) -#endif - import Outputable import Pretty import Util @@ -255,9 +251,14 @@ The @Chars@ are ``tag letters'' that identify the @UniqueSupply@. Fast comparison is everything on @Uniques@: \begin{code} -u2i :: Unique -> FAST_INT - data Unique = MkUnique Int# + +class Uniquable a where + uniqueOf :: a -> Unique +\end{code} + +\begin{code} +u2i :: Unique -> FAST_INT u2i (MkUnique i) = i \end{code} diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index e5916e4..37937d0 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -53,8 +53,7 @@ import Outputable ( PprStyle(..) ) import Pretty ( Doc ) import PrimRep ( PrimRep ) import StgSyn ( SYN_IE(StgArg), SYN_IE(StgLiveVars), GenStgArg(..) ) -import Unique ( Unique ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, Uniquable(..) ) import Util ( zipWithEqual, panic ) \end{code} diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index 1c15b4b..c6eb9f0 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -73,8 +73,7 @@ import Type ( typePrimRep, maybeAppSpecDataTyConExpandingDicts, SYN_IE(Type) ) -import Unique ( Unique ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, Uniquable(..) ) import Util ( sortLt, isIn, isn'tIn, zipEqual, pprError, panic, assertPanic ) diff --git a/ghc/compiler/deSugar/DsGRHSs.lhs b/ghc/compiler/deSugar/DsGRHSs.lhs index 63c41d7..b22c6fa 100644 --- a/ghc/compiler/deSugar/DsGRHSs.lhs +++ b/ghc/compiler/deSugar/DsGRHSs.lhs @@ -38,8 +38,7 @@ import PrelVals ( nON_EXHAUSTIVE_GUARDS_ERROR_ID ) import Outputable ( PprStyle(..) ) import SrcLoc ( SrcLoc{-instance-} ) import Type ( SYN_IE(Type) ) -import Unique ( Unique, otherwiseIdKey ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, otherwiseIdKey, Uniquable(..) ) import Util ( panic ) \end{code} diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs index f28cff8..c3a8a6d 100644 --- a/ghc/compiler/hsSyn/HsBinds.lhs +++ b/ghc/compiler/hsSyn/HsBinds.lhs @@ -196,17 +196,17 @@ ppr_monobind sty (AndMonoBinds binds1 binds2) = ($$) (ppr_monobind sty binds1) (ppr_monobind sty binds2) ppr_monobind sty (PatMonoBind pat grhss_n_binds locn) - = hang (ppr sty pat) 4 (pprGRHSsAndBinds sty False grhss_n_binds) + = sep [ppr sty pat, nest 4 (pprGRHSsAndBinds sty False grhss_n_binds)] ppr_monobind sty (FunMonoBind fun inf matches locn) = pprMatches sty (False, ppr sty fun) matches -- ToDo: print infix if appropriate ppr_monobind sty (VarMonoBind name expr) - = hang (hsep [ppr sty name, equals]) 4 (pprExpr sty expr) + = sep [ppr sty name <+> equals, nest 4 (pprExpr sty expr)] ppr_monobind sty (CoreMonoBind name expr) - = hang (hsep [ppr sty name, equals]) 4 (ppr sty expr) + = sep [ppr sty name <+> equals, nest 4 (ppr sty expr)] ppr_monobind sty (AbsBinds tyvars dictvars exports val_binds) = ($$) (sep [ptext SLIT("AbsBinds"), diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs index b83f4b8..ba9adf6 100644 --- a/ghc/compiler/hsSyn/HsTypes.lhs +++ b/ghc/compiler/hsSyn/HsTypes.lhs @@ -118,7 +118,7 @@ ppr_forall sty ctxt_prec tvs ctxt ty pprContext :: (Outputable name) => PprStyle -> (Context name) -> Doc pprContext sty [] = empty pprContext sty context - = hsep [braces (hsep (punctuate comma (map ppr_assert context)))] + = pprQuote sty $ \ sty -> parens (hsep (punctuate comma (map ppr_assert context))) where ppr_assert (clas, ty) = hsep [ppr sty clas, ppr sty ty] \end{code} diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index a2af742..13897a8 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -77,10 +77,9 @@ import Stix ( sStLitLbl, StixTree(..), StixReg(..), CodeSegment ) import Unique ( mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3, - Unique{-instance Ord3-} + Unique{-instance Ord3-}, Uniquable(..) ) import UniqSupply ( getUnique, returnUs, thenUs, SYN_IE(UniqSM) ) -import UniqFM ( Uniquable(..) ) import Util ( panic, Ord3(..) ) \end{code} diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 37de70c..f28f218 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -60,7 +60,7 @@ import TyCon ( tyConDataCons, mkFunTyCon, TyCon ) import Type import Bag import Unique -- *Key stuff -import UniqFM ( UniqFM, listToUFM, Uniquable(..) ) +import UniqFM ( UniqFM, listToUFM ) import Util ( isIn ) \end{code} diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index d926583..43abb70 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -30,8 +30,8 @@ import TyCon ( TyCon ) import TysWiredIn ( tupleTyCon, listTyCon, charTyCon, intTyCon ) import FiniteMap import Outputable -import Unique ( Unique, unboundKey ) -import UniqFM ( Uniquable(..), listToUFM, plusUFM_C ) +import Unique ( Unique, Uniquable(..), unboundKey ) +import UniqFM ( listToUFM, plusUFM_C ) import Maybes ( maybeToBool ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index 31dbf24..ac323ac 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -143,17 +143,27 @@ rnPat (RecPatIn con rpats) ************************************************************************ \begin{code} -rnMatch :: RdrNameMatch -> RnMS s (RenamedMatch, FreeVars) +rnMatch, rnMatch1 :: RdrNameMatch -> RnMS s (RenamedMatch, FreeVars) -rnMatch (PatMatch pat match) - = bindLocalsRn "pattern" binders $ \ new_binders -> - rnPat pat `thenRn` \ pat' -> - rnMatch match `thenRn` \ (match', fvMatch) -> - returnRn (PatMatch pat' match', fvMatch `minusNameSet` mkNameSet new_binders) +-- The only tricky bit here is that we want to do a single +-- bindLocalsRn for all the matches together, so that we spot +-- the repeated variable in +-- f x x = 1 + +rnMatch match + = bindLocalsRn "pattern" (get_binders match) $ \ new_binders -> + rnMatch1 match `thenRn` \ (match', fvs) -> + returnRn (match', fvs `minusNameSet` mkNameSet new_binders) where - binders = collectPatBinders pat + get_binders (GRHSMatch _) = [] + get_binders (PatMatch pat match) = collectPatBinders pat ++ get_binders match + +rnMatch1 (PatMatch pat match) + = rnPat pat `thenRn` \ pat' -> + rnMatch1 match `thenRn` \ (match', fvs) -> + returnRn (PatMatch pat' match', fvs) -rnMatch (GRHSMatch grhss_and_binds) +rnMatch1 (GRHSMatch grhss_and_binds) = rnGRHSsAndBinds grhss_and_binds `thenRn` \ (grhss_and_binds', fvs) -> returnRn (GRHSMatch grhss_and_binds', fvs) \end{code} diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs index ff3620e..a40921f 100644 --- a/ghc/compiler/rename/RnSource.lhs +++ b/ghc/compiler/rename/RnSource.lhs @@ -51,7 +51,7 @@ import PrelInfo ( derivingOccurrences, evalClass_RDR, numClass_RDR, allClass_NA import ListSetOps ( unionLists, minusList ) import Maybes ( maybeToBool, catMaybes ) import Bag ( emptyBag, unitBag, consBag, unionManyBags, unionBags, listToBag, bagToList ) -import Outputable ( PprStyle(..), Outputable(..){-instances-} ) +import Outputable ( PprStyle(..), Outputable(..){-instances-}, pprQuote ) import Pretty import SrcLoc ( SrcLoc ) import Unique ( Unique ) @@ -705,17 +705,17 @@ classTyVarNotInOpTyErr clas_tyvar sig sty ptext SLIT("does not appear in method signature")]) 4 (ppr sty sig) -dupClassAssertWarn ctxt dups sty - = hang (hcat [ptext SLIT("Duplicate class assertion `"), - ppr sty dups, - ptext SLIT("' in context:")]) - 4 (ppr sty ctxt) +dupClassAssertWarn ctxt ((clas,ty) : dups) sty + = hang (hcat [ptext SLIT("Duplicated class assertion"), + pprQuote sty $ \ sty -> ppr sty clas <+> ppr sty ty, + ptext SLIT("in context:")]) + 4 (pprContext sty ctxt) badDataCon name sty - = hsep [ptext SLIT("Illegal data constructor name:"), ppr sty name] + = hsep [ptext SLIT("Illegal data constructor name"), ppr sty name] allOfNonTyVar ty sty - = hsep [ptext SLIT("`All' applied to a non-type variable:"), ppr sty ty] + = hsep [ptext SLIT("`All' applied to a non-type variable"), ppr sty ty] ctxtErr1 doc tyvars sty = hsep [ptext SLIT("Context constrains in-scope type variable(s)"), diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs index c96b21d..62d6eb8 100644 --- a/ghc/compiler/simplCore/SimplCore.lhs +++ b/ghc/compiler/simplCore/SimplCore.lhs @@ -64,8 +64,7 @@ import Specialise import SpecUtils ( pprSpecErrs ) import StrictAnal ( saWwTopBinds ) import TyVar ( nullTyVarEnv, GenTyVar{-instance Eq-} ) -import Unique ( integerTyConKey, ratioTyConKey, Unique{-instance Eq-} ) -import UniqFM ( Uniquable(..) ) +import Unique ( integerTyConKey, ratioTyConKey, Unique{-instance Eq-}, Uniquable(..) ) import UniqSupply ( splitUniqSupply, getUnique, UniqSupply ) import Util ( mapAccumL, assertPanic, panic{-ToDo:rm-}, pprTrace, pprPanic ) import SrcLoc ( noSrcLoc ) diff --git a/ghc/compiler/simplCore/SimplEnv.lhs b/ghc/compiler/simplCore/SimplEnv.lhs index 3775477..52d8a97 100644 --- a/ghc/compiler/simplCore/SimplEnv.lhs +++ b/ghc/compiler/simplCore/SimplEnv.lhs @@ -83,9 +83,8 @@ import TyVar ( nullTyVarEnv, addOneToTyVarEnv, growTyVarEnvList, SYN_IE(TyVarEnv), GenTyVar{-instance Eq-} , SYN_IE(TyVar) ) -import Unique ( Unique{-instance Outputable-} ) -import UniqFM ( addToUFM_C, ufmToList, Uniquable(..) - ) +import Unique ( Unique{-instance Outputable-}, Uniquable(..) ) +import UniqFM ( addToUFM_C, ufmToList ) import Usage ( SYN_IE(UVar), GenUsage{-instances-} ) import Util ( SYN_IE(Eager), appEager, returnEager, runEager, zipEqual, thenCmp, cmpList, panic, panic#, assertPanic, Ord3(..) ) diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs index 0b577af..5eecebb 100644 --- a/ghc/compiler/typecheck/TcClassDcl.lhs +++ b/ghc/compiler/typecheck/TcClassDcl.lhs @@ -61,8 +61,7 @@ import Type ( mkFunTy, mkTyVarTy, mkTyVarTys, mkDictTy, ) import TysWiredIn ( stringTy ) import TyVar ( unitTyVarSet, GenTyVar, SYN_IE(TyVar) ) -import Unique ( Unique ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, Uniquable(..) ) import Util diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index 3327ece..4b45f0a 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -52,7 +52,7 @@ import Name ( Name, OccName(..), getSrcLoc, occNameString, NamedThing(..) ) import Pretty -import Unique ( pprUnique10{-, pprUnique ToDo:rm-}, Unique ) +import Unique ( pprUnique10{-, pprUnique ToDo:rm-}, Unique, Uniquable(..) ) import UniqFM import Util ( zipEqual, zipWithEqual, zipWith3Equal, zipLazy, panic, pprPanic, pprTrace diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs index 8d988ab..45ed913 100644 --- a/ghc/compiler/typecheck/TcInstDcls.lhs +++ b/ghc/compiler/typecheck/TcInstDcls.lhs @@ -86,16 +86,15 @@ import Pretty import TyCon ( isSynTyCon, isDataTyCon, derivedClasses ) import Type ( GenType(..), SYN_IE(ThetaType), mkTyVarTys, isPrimType, splitSigmaTy, splitAppTys, isTyVarTy, matchTy, mkSigmaTy, - getTyCon_maybe, maybeAppTyCon, SYN_IE(Type), + getTyCon_maybe, maybeAppTyCon, SYN_IE(Type), getTyVar, maybeBoxedPrimType, maybeAppDataTyCon, splitRhoTy, eqTy ) import TyVar ( GenTyVar, SYN_IE(GenTyVarSet), tyVarSetToList, mkTyVarSet, unionTyVarSets, SYN_IE(TyVar) ) import TysPrim ( byteArrayPrimTyCon, mutableByteArrayPrimTyCon ) import TysWiredIn ( stringTy ) -import Unique ( Unique, cCallableClassKey, cReturnableClassKey ) -import UniqFM ( Uniquable(..) ) -import Util ( zipEqual, panic, pprPanic, pprTrace +import Unique ( Unique, cCallableClassKey, cReturnableClassKey, Uniquable(..) ) +import Util ( zipEqual, panic, pprPanic, pprTrace, removeDups, Ord3(..), #if __GLASGOW_HASKELL__ < 202 , trace #endif @@ -665,8 +664,9 @@ scrutiniseInstanceType dfun_name clas inst_tau = returnTc (inst_tycon,arg_tys) -- TYVARS CHECK - | not (all isTyVarTy arg_tys || - opt_GlasgowExts) + | not (opt_GlasgowExts || + (all isTyVarTy arg_tys && null tyvar_dups) + ) = failTc (instTypeErr inst_tau) -- DERIVING CHECK @@ -692,6 +692,7 @@ scrutiniseInstanceType dfun_name clas inst_tau (possible_tycon, arg_tys) = splitAppTys inst_tau inst_tycon_maybe = getTyCon_maybe possible_tycon inst_tycon = expectJust "tcInstDecls1:inst_tycon" inst_tycon_maybe + (_, tyvar_dups) = removeDups cmp (map (getTyVar "tcInstDecls1:getTyVarTy") arg_tys) -- These conditions come directly from what the DsCCall is capable of. -- Totally grotesque. Green card should solve this. @@ -727,11 +728,11 @@ creturnable_type ty = maybeToBool (maybeBoxedPrimType ty) || instTypeErr ty sty = case ty of - SynTy tc _ _ -> hcat [ptext SLIT("The type synonym `"), ppr sty tc, rest_of_msg] - TyVarTy tv -> hcat [ptext SLIT("The type variable `"), ppr sty tv, rest_of_msg] - other -> hcat [ptext SLIT("The type `"), ppr sty ty, rest_of_msg] + SynTy tc _ _ -> hsep [ptext SLIT("The type synonym"), ppr sty tc, rest_of_msg] + TyVarTy tv -> hsep [ptext SLIT("The type variable"), ppr sty tv, rest_of_msg] + other -> hsep [ptext SLIT("The type"), ppr sty ty, rest_of_msg] where - rest_of_msg = ptext SLIT("' cannot be used as an instance type.") + rest_of_msg = ptext SLIT("cannot be used as an instance type") instBndrErr bndr clas sty = hsep [ptext SLIT("Class"), ppr sty clas, ptext SLIT("does not have a method"), ppr sty bndr] diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs index 0f2ad84..d2cd24f 100644 --- a/ghc/compiler/typecheck/TcMonoType.lhs +++ b/ghc/compiler/typecheck/TcMonoType.lhs @@ -29,9 +29,8 @@ import PrelInfo ( cCallishClassKeys ) import TyCon ( TyCon ) import Name ( Name, OccName, isTvOcc, getOccName ) import TysWiredIn ( mkListTy, mkTupleTy ) -import Unique ( Unique ) +import Unique ( Unique, Uniquable(..) ) import Pretty -import UniqFM ( Uniquable(..) ) import Util ( zipWithEqual, zipLazy, panic{-, pprPanic ToDo:rm-} ) diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs index 4b2241c..021ce0d 100644 --- a/ghc/compiler/typecheck/TcPat.lhs +++ b/ghc/compiler/typecheck/TcPat.lhs @@ -64,7 +64,7 @@ tcPat :: RenamedPat -> TcM s (TcPat s, LIE s, TcType s) \begin{code} tcPat (VarPatIn name) - = tcLookupLocalValueOK ("tcPat1:"{-++show (ppr PprDebug name)-}) name `thenNF_Tc` \ id -> + = tcLookupLocalValueOK "tcPat1:" name `thenNF_Tc` \ id -> returnTc (VarPat (TcId id), emptyLIE, idType id) tcPat (LazyPatIn pat) diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs index bd06cd5..22eaf9e 100644 --- a/ghc/compiler/typecheck/TcTyClsDecls.lhs +++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs @@ -42,8 +42,7 @@ import UniqSet ( SYN_IE(UniqSet), emptyUniqSet, unionManyUniqSets, uniqSetToList ) import SrcLoc ( SrcLoc ) import TyCon ( TyCon, SYN_IE(Arity) ) -import Unique ( Unique ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, Uniquable(..) ) import Util ( panic{-, pprTrace-} ) \end{code} diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs index 16496e0..945a1d5 100644 --- a/ghc/compiler/types/Class.lhs +++ b/ghc/compiler/types/Class.lhs @@ -48,7 +48,6 @@ import Maybes ( assocMaybe ) import Name ( changeUnique, Name, OccName, occNameString ) import Outputable import Unique -- Keys for built-in classes -import UniqFM ( Uniquable(..) ) import Pretty ( Doc, hsep, ptext ) import SrcLoc ( SrcLoc ) import Util diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs index 6a2f827..1cf7336 100644 --- a/ghc/compiler/types/PprType.lhs +++ b/ghc/compiler/types/PprType.lhs @@ -54,9 +54,8 @@ import Outputable ( PprStyle(..), codeStyle, userStyle, ifaceStyle, ifPprShowAll, interpp'SP, Outputable(..) ) import PprEnv import Pretty -import UniqFM ( addToUFM_Directly, lookupUFM_Directly{-, ufmToList ToDo:rm-}, - Uniquable(..) ) -import Unique --TEMP: ( pprUnique10, pprUnique, incrUnique, listTyConKey ) +import UniqFM ( addToUFM_Directly, lookupUFM_Directly ) +import Unique ( Uniquable(..), pprUnique10, pprUnique, incrUnique, listTyConKey ) import Util \end{code} diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 0608ba5..ada7c8d 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -49,10 +49,9 @@ IMPORT_DELOOPER(TyLoop) ( SYN_IE(Type), GenType, --LATER: specMaybeTysSuffix ) #else -import {-# SOURCE #-} Type ( Type ) +import {-# SOURCE #-} Type ( Type, splitSigmaTy, splitFunTy ) import {-# SOURCE #-} Class ( Class ) import {-# SOURCE #-} Id ( Id, isNullaryDataCon, idType ) -import {-# SOURCE #-} Type ( splitSigmaTy, splitFunTy ) import {-# SOURCE #-} TysWiredIn ( tupleCon ) #endif @@ -63,8 +62,7 @@ import Kind ( Kind, mkBoxedTypeKind, mkArrowKind, resultKind, argKind ) import Maybes import Name ( Name, nameUnique, mkWiredInTyConName, NamedThing(getName) ) -import Unique ( Unique, funTyConKey ) -import UniqFM ( Uniquable(..) ) +import Unique ( Unique, funTyConKey, Uniquable(..) ) import Pretty ( Doc ) import PrimRep ( PrimRep(..) ) import PrelMods ( gHC__, pREL_TUP, pREL_BASE ) diff --git a/ghc/compiler/types/TyVar.lhs b/ghc/compiler/types/TyVar.lhs index 0fdfc32..8db508b 100644 --- a/ghc/compiler/types/TyVar.lhs +++ b/ghc/compiler/types/TyVar.lhs @@ -38,8 +38,7 @@ import Name ( mkSysLocalName, changeUnique, Name, NamedThing(..) ) import Pretty ( Doc, (<>), ptext ) import Outputable ( PprStyle(..), Outputable(..) ) import SrcLoc ( noSrcLoc, SrcLoc ) -import Unique ( showUnique, mkAlphaTyVarUnique, Unique ) -import UniqFM ( Uniquable(..) ) +import Unique ( showUnique, mkAlphaTyVarUnique, Unique, Uniquable(..) ) import Util ( panic, Ord3(..) ) \end{code} diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs index 294f423..da4941a 100644 --- a/ghc/compiler/types/Type.lhs +++ b/ghc/compiler/types/Type.lhs @@ -74,7 +74,6 @@ import Name ( NamedThing(..), import Maybes ( maybeToBool, assocMaybe ) import PrimRep ( PrimRep(..) ) import Unique -- quite a few *Keys -import UniqFM ( Uniquable(..) ) import Util ( thenCmp, zipEqual, assoc, panic, panic#, assertPanic, pprPanic, Ord3(..){-instances-} diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs index 463cc79..e55979c 100644 --- a/ghc/compiler/utils/FastString.lhs +++ b/ghc/compiler/utils/FastString.lhs @@ -53,8 +53,7 @@ import IOBase import IOHandle import ST import STBase -import {-# SOURCE #-} Unique ( mkUniqueGrimily, Unique ) -import {-# SOURCE #-} UniqFM ( Uniquable(..) ) +import {-# SOURCE #-} Unique ( mkUniqueGrimily, Unique, Uniquable(..) ) #if __GLASGOW_HASKELL__ == 202 import PrelBase ( Char (..) ) #endif diff --git a/ghc/compiler/utils/Pretty.lhs b/ghc/compiler/utils/Pretty.lhs index c8aef7d..54abced 100644 --- a/ghc/compiler/utils/Pretty.lhs +++ b/ghc/compiler/utils/Pretty.lhs @@ -418,7 +418,7 @@ hcat = foldr (<>) empty hsep = foldr (<+>) empty vcat = foldr ($$) empty -hang d1 n d2 = d1 $$ (nest n d2) +hang d1 n d2 = sep [d1, nest n d2] punctuate p [] = [] punctuate p (d:ds) = go d ds diff --git a/ghc/compiler/utils/Ubiq.lhi b/ghc/compiler/utils/Ubiq.lhi index 4f6d3c6..c02b806 100644 --- a/ghc/compiler/utils/Ubiq.lhi +++ b/ghc/compiler/utils/Ubiq.lhi @@ -3,7 +3,6 @@ Things which are ubiquitous in the GHC compiler. \begin{code} interface Ubiq where ---import PreludePS(_PackedString) import FastString(FastString) import BasicTypes ( Module(..), Arity(..) ) diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs index 1cd56ff..12de7a5 100644 --- a/ghc/compiler/utils/UniqFM.lhs +++ b/ghc/compiler/utils/UniqFM.lhs @@ -21,7 +21,6 @@ Basically, the things need to be in class @Uniquable@, and we use the module UniqFM ( UniqFM, -- abstract type - Uniquable(..), -- class to go with it emptyUFM, unitUFM, @@ -64,7 +63,7 @@ import {-# SOURCE #-} Name # endif #endif -import Unique ( Unique, u2i, mkUniqueGrimily ) +import Unique ( Uniquable(..), Unique, u2i, mkUniqueGrimily ) import Util import Pretty ( Doc ) import Outputable ( PprStyle, Outputable(..) ) @@ -207,9 +206,6 @@ data UniqFM ele (UniqFM ele) (UniqFM ele) -class Uniquable a where - uniqueOf :: a -> Unique - -- for debugging only :-) {- instance Text (UniqFM a) where diff --git a/ghc/compiler/utils/UniqSet.lhs b/ghc/compiler/utils/UniqSet.lhs index 8772f2c..2f53d06 100644 --- a/ghc/compiler/utils/UniqSet.lhs +++ b/ghc/compiler/utils/UniqSet.lhs @@ -28,7 +28,7 @@ import {-# SOURCE #-} Name import Maybes ( maybeToBool ) import UniqFM -import Unique ( Unique ) +import Unique ( Unique, Uniquable(..) ) import SrcLoc ( SrcLoc ) import Outputable ( PprStyle, Outputable(..) ) import Pretty ( Doc ) -- 1.7.10.4