X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnTypes.lhs;h=62281b56a171f16f75d18660bde8cd8a62958f70;hp=ea10ccef809d2e260c5a21c539cb074445b1fb94;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hpb=da95f4a039f7bc12b625338353df8399dec41c5e diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs index ea10cce..62281b5 100644 --- a/ghc/compiler/typecheck/TcRnTypes.lhs +++ b/ghc/compiler/typecheck/TcRnTypes.lhs @@ -9,10 +9,10 @@ module TcRnTypes( -- The environment types Env(..), TcGblEnv(..), TcLclEnv(..), - IfGblEnv(..), IfLclEnv(..), + IfGblEnv(..), IfLclEnv(..), -- Ranamer types - EntityUsage, emptyUsages, ErrCtxt, + ErrCtxt, ImportAvails(..), emptyImportAvails, plusImportAvails, plusAvail, pruneAvails, AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, @@ -20,14 +20,15 @@ module TcRnTypes( WhereFrom(..), mkModDeps, -- Typechecker types - TcTyThing(..), GadtRefinement, + TcTyThing(..), pprTcTyThingCategory, + GadtRefinement, -- Template Haskell ThStage(..), topStage, topSpliceStage, ThLevel, impLevel, topLevel, -- Arrows - ArrowCtxt(..), topArrowCtxt, ProcLevel, topProcLevel, + ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope, -- Insts Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, @@ -42,26 +43,27 @@ module TcRnTypes( #include "HsVersions.h" import HsSyn ( PendingSplice, HsOverLit, LRuleDecl, LForeignDecl, - ArithSeqInfo, DictBinds, LHsBinds ) + ArithSeqInfo, DictBinds, LHsBinds, LImportDecl, HsGroup, + IE ) import HscTypes ( FixityEnv, HscEnv, TypeEnv, TyThing, - GenAvailInfo(..), AvailInfo, + GenAvailInfo(..), AvailInfo, HscSource(..), availName, IsBootInterface, Deprecations ) -import Packages ( PackageName ) -import Type ( Type, TvSubstEnv ) -import TcType ( TcTyVarSet, TcType, TcTauType, TcThetaType, SkolemInfo, - TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes ) -import InstEnv ( DFunId, InstEnv ) +import Packages ( PackageId, HomeModules ) +import Type ( Type, pprTyThingCategory ) +import TcType ( TcTyVarSet, TcType, TcThetaType, SkolemInfo, TvSubst, + TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes, pprSkolInfo ) +import InstEnv ( Instance, InstEnv ) import IOEnv import RdrName ( GlobalRdrEnv, LocalRdrEnv ) import Name ( Name ) import NameEnv -import NameSet ( NameSet, emptyNameSet, DefUses ) +import NameSet ( NameSet, unionNameSets, DefUses ) import OccName ( OccEnv ) import Var ( Id, TyVar ) import VarEnv ( TidyEnv ) import Module -import SrcLoc ( SrcSpan, SrcLoc, srcSpanStart ) +import SrcLoc ( SrcSpan, SrcLoc, Located, srcSpanStart ) import VarSet ( IdSet ) import ErrUtils ( Messages, Message ) import UniqSupply ( UniqSupply ) @@ -129,6 +131,9 @@ data Env gbl lcl -- Changes as we move into an expression data TcGblEnv = TcGblEnv { tcg_mod :: Module, -- Module being compiled + tcg_src :: HscSource, -- What kind of module + -- (regular Haskell, hs-boot, ext-core) + tcg_rdr_env :: GlobalRdrEnv, -- Top level envt; used during renaming tcg_default :: Maybe [Type], -- Types used for defaulting -- Nothing => no 'default' decl @@ -150,21 +155,6 @@ data TcGblEnv tcg_inst_env :: InstEnv, -- Instance envt for *home-package* modules -- Includes the dfuns in tcg_insts - tcg_inst_uses :: TcRef NameSet, -- Home-package Dfuns actually used - -- Used to generate version dependencies - -- This records usages, rather like tcg_dus, but it has to - -- be a mutable variable so it can be augmented - -- when we look up an instance. These uses of dfuns are - -- rather like the free variables of the program, but - -- are implicit instead of explicit. - - tcg_th_used :: TcRef Bool, -- True <=> Template Haskell syntax used - -- We need this so that we can generate a dependency on the - -- Template Haskell package, becuase the desugarer is going to - -- emit loads of references to TH symbols. It's rather like - -- tcg_inst_uses; the reference is implicit rather than explicit, - -- so we have to zap a mutable variable. - -- Now a bunch of things about this module that are simply -- accumulated, but never consulted until the end. -- Nevertheless, it's convenient to accumulate them along @@ -174,24 +164,68 @@ data TcGblEnv -- from where, including things bound -- in this module + tcg_home_mods :: HomeModules, + -- Calculated from ImportAvails, allows us to + -- call Packages.isHomeModule + tcg_dus :: DefUses, -- What is defined in this module and what is used. -- The latter is used to generate -- (a) version tracking; no need to recompile if these -- things have not changed version stamp -- (b) unused-import info - tcg_keep :: NameSet, -- Set of names to keep alive, and to expose in the - -- interface file (but not to export to the user). - -- These are typically extra definitions generated from - -- data type declarations which would otherwise be - -- dropped as dead code. + tcg_keep :: TcRef NameSet, -- Locally-defined top-level names to keep alive + -- "Keep alive" means give them an Exported flag, so + -- that the simplifier does not discard them as dead + -- code, and so that they are exposed in the interface file + -- (but not to export to the user). + -- + -- Some things, like dict-fun Ids and default-method Ids are + -- "born" with the Exported flag on, for exactly the above reason, + -- but some we only discover as we go. Specifically: + -- * The to/from functions for generic data types + -- * Top-level variables appearing free in the RHS of an orphan rule + -- * Top-level variables appearing free in a TH bracket + + tcg_inst_uses :: TcRef NameSet, -- Home-package Dfuns actually used + -- Used to generate version dependencies + -- This records usages, rather like tcg_dus, but it has to + -- be a mutable variable so it can be augmented + -- when we look up an instance. These uses of dfuns are + -- rather like the free variables of the program, but + -- are implicit instead of explicit. + + tcg_th_used :: TcRef Bool, -- True <=> Template Haskell syntax used + -- We need this so that we can generate a dependency on the + -- Template Haskell package, becuase the desugarer is going to + -- emit loads of references to TH symbols. It's rather like + -- tcg_inst_uses; the reference is implicit rather than explicit, + -- so we have to zap a mutable variable. + + tcg_dfun_n :: TcRef Int, -- Allows us to number off the names of DFuns + -- It's convenient to allocate an External Name for a DFun, with + -- a permanently-fixed unique, just like other top-level functions + -- defined in this module. But that means we need a canonical + -- occurrence name, distinct from all other dfuns in this module, + -- and this name supply serves that purpose (df1, df2, etc). -- The next fields accumulate the payload of the module -- The binds, rules and foreign-decl fiels are collected -- initially in un-zonked form and are finally zonked in tcRnSrcDecls + + -- The next fields accumulate the payload of the + -- module The binds, rules and foreign-decl fiels are + -- collected initially in un-zonked form and are + -- finally zonked in tcRnSrcDecls + + tcg_rn_imports :: Maybe [LImportDecl Name], + tcg_rn_exports :: Maybe [Located (IE Name)], + tcg_rn_decls :: Maybe (HsGroup Name), -- renamed decls, maybe + -- Nothing <=> Don't retain renamed decls + tcg_binds :: LHsBinds Id, -- Value bindings in this module tcg_deprecs :: Deprecations, -- ...Deprecations - tcg_insts :: [DFunId], -- ...Instances + tcg_insts :: [Instance], -- ...Instances tcg_rules :: [LRuleDecl Id], -- ...Rules tcg_fords :: [LForeignDecl Id] -- ...Foreign import & exports } @@ -223,7 +257,14 @@ data IfLclEnv -- The module for the current IfaceDecl -- So if we see f = \x -> x -- it means M.f = \x -> x, where M is the if_mod - if_mod :: ModuleName, + if_mod :: Module, + + -- The field is used only for error reporting + -- if (say) there's a Lint error in it + if_loc :: SDoc, + -- Where the interface came from: + -- .hi file, or GHCi state, or ext core + -- plus which bit is currently being examined if_tv_env :: OccEnv TyVar, -- Nested tyvar bindings if_id_env :: OccEnv Id -- Nested id binding @@ -278,24 +319,49 @@ data TcLclEnv -- Changes as we move inside an expression tcl_env :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars -- defined in this module - tcl_gadt :: GadtRefinement, -- The current type refinement for GADTs - tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars" - -- Namely, the in-scope TyVars bound in tcl_lenv, + -- Namely, the in-scope TyVars bound in tcl_env, -- plus the tyvars mentioned in the types of Ids bound in tcl_lenv -- Why mutable? see notes with tcGetGlobalTyVars - tcl_lie :: TcRef LIE -- Place to accumulate type constraints + tcl_lie :: TcRef LIE -- Place to accumulate type constraints } -type GadtRefinement = TvSubstEnv -- Binds rigid type variables to their refinements +type GadtRefinement = TvSubst +{- Note [Given Insts] + ~~~~~~~~~~~~~~~~~~ +Because of GADTs, we have to pass inwards the Insts provided by type signatures +and existential contexts. Consider + data T a where { T1 :: b -> b -> T [b] } + f :: Eq a => T a -> Bool + f (T1 x y) = [x]==[y] + +The constructor T1 binds an existential variable 'b', and we need Eq [b]. +Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we +pass it inwards. + +-} --------------------------- -- Template Haskell levels --------------------------- -type ThLevel = Int -- Always >= 0 +type ThLevel = Int + -- Indicates how many levels of brackets we are inside + -- (always >= 0) + -- Incremented when going inside a bracket, + -- decremented when going inside a splice + +impLevel, topLevel :: ThLevel +topLevel = 1 -- Things defined at top level of this module +impLevel = 0 -- Imported things; they can be used inside a top level splice +-- +-- For example: +-- f = ... +-- g1 = $(map ...) is OK +-- g2 = $(f ...) is not OK; because we havn't compiled f yet + data ThStage = Comp -- Ordinary compiling, at level topLevel @@ -307,67 +373,76 @@ topStage, topSpliceStage :: ThStage topStage = Comp topSpliceStage = Splice (topLevel - 1) -- Stage for the body of a top-level splice +--------------------------- +-- Arrow-notation context +--------------------------- -impLevel, topLevel :: ThLevel -topLevel = 1 -- Things defined at top level of this module -impLevel = 0 -- Imported things; they can be used inside a top level splice --- --- For example: --- f = ... --- g1 = $(map ...) is OK --- g2 = $(f ...) is not OK; because we havn't compiled f yet +{- +In arrow notation, a variable bound by a proc (or enclosed let/kappa) +is not in scope to the left of an arrow tail (-<) or the head of (|..|). +For example + proc x -> (e1 -< e2) ---------------------------- --- Arrow-notation stages ---------------------------- +Here, x is not in scope in e1, but it is in scope in e2. This can get +a bit complicated: --- In arrow notation, a variable bound by a proc (or enclosed let/kappa) --- is not in scope to the left of an arrow tail (-<). For example --- --- proc x -> (e1 -< e2) --- --- Here, x is not in scope in e1, but it is in scope in e2. This can get --- a bit complicated: --- --- let x = 3 in --- prox y -> (proc z -> e1) -< e2 --- --- Here, x and z are in scope in e1, but y is not. Here's how we track this: --- a) Assign an "proc level" to each proc, being the number of --- lexically-enclosing procs + 1. --- b) Assign to each local variable the proc-level of its lexically --- enclosing proc. --- c) Keep a list of out-of-scope procs. When moving to the left of --- an arrow-tail, add the proc-level of the immediately enclosing --- proc to the list. --- d) When looking up a variable, complain if its proc-level is in --- the banned list + let x = 3 in + proc y -> (proc z -> e1) -< e2 + +Here, x and z are in scope in e1, but y is not. We implement this by +recording the environment when passing a proc (using newArrowScope), +and returning to that (using escapeArrowScope) on the left of -< and the +head of (|..|). +-} -type ProcLevel = Int -- Always >= 0 -topProcLevel = 0 -- Not inside any proc +data ArrowCtxt + = NoArrowCtxt + | ArrowCtxt (Env TcGblEnv TcLclEnv) -data ArrowCtxt = ArrCtxt { proc_level :: ProcLevel, -- Current level - proc_banned :: [ProcLevel] } -- Out of scope proc-levels +-- Record the current environment (outside a proc) +newArrowScope :: TcM a -> TcM a +newArrowScope + = updEnv $ \env -> + env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } } -topArrowCtxt = ArrCtxt { proc_level = topProcLevel, proc_banned = [] } +-- Return to the stored environment (from the enclosing proc) +escapeArrowScope :: TcM a -> TcM a +escapeArrowScope + = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of + NoArrowCtxt -> env + ArrowCtxt env' -> env' --------------------------- -- TcTyThing --------------------------- data TcTyThing - = AGlobal TyThing -- Used only in the return type of a lookup - | ATcId TcId ThLevel ProcLevel -- Ids defined in this module; may not be fully zonked - | ATyVar TyVar -- Type variables - | AThing TcKind -- Used temporarily, during kind checking, for the - -- tycons and clases in this recursive group + = AGlobal TyThing -- Used only in the return type of a lookup + + | ATcId TcId -- Ids defined in this module; may not be fully zonked + ThLevel + Bool -- True <=> apply the type refinement to me + + | ATyVar Name TcType -- The type to which the lexically scoped type vaiable + -- is currently refined. We only need the Name + -- for error-message purposes + + | AThing TcKind -- Used temporarily, during kind checking, for the + -- tycons and clases in this recursive group instance Outputable TcTyThing where -- Debugging only - ppr (AGlobal g) = text "AGlobal" <+> ppr g - ppr (ATcId g tl pl) = text "ATcId" <+> ppr g <+> ppr tl <+> ppr pl - ppr (ATyVar t) = text "ATyVar" <+> ppr t + ppr (AGlobal g) = ppr g + ppr (ATcId g tl rig) = text "Identifier" <> + ifPprDebug (brackets (ppr g <> comma <> ppr tl <+> ppr rig)) + ppr (ATyVar tv _) = text "Type variable" <+> quotes (ppr tv) ppr (AThing k) = text "AThing" <+> ppr k + +pprTcTyThingCategory :: TcTyThing -> SDoc +pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing +pprTcTyThingCategory (ATyVar {}) = ptext SLIT("Type variable") +pprTcTyThingCategory (ATcId {}) = ptext SLIT("Local identifier") +pprTcTyThingCategory (AThing {}) = ptext SLIT("Kinded thing") \end{code} \begin{code} @@ -380,32 +455,6 @@ type ErrCtxt = [TidyEnv -> TcM (TidyEnv, Message)] %************************************************************************ %* * - EntityUsage -%* * -%************************************************************************ - -EntityUsage tells what things are actually need in order to compile this -module. It is used for generating the usage-version field of the ModIface. - -Note that we do not record version info for entities from -other (non-home) packages. If the package changes, GHC doesn't help. - -\begin{code} -type EntityUsage = NameSet - -- The Names are all the (a) home-package - -- (b) "big" (i.e. no data cons, class ops) - -- (c) non-locally-defined - -- (d) non-wired-in - -- names that have been slurped in so far. - -- This is used to generate the "usage" information for this module. - -emptyUsages :: EntityUsage -emptyUsages = emptyNameSet -\end{code} - - -%************************************************************************ -%* * Operations over ImportAvails %* * %************************************************************************ @@ -421,73 +470,62 @@ It is used * when processing the export list \begin{code} data ImportAvails = ImportAvails { - imp_env :: AvailEnv, - -- All the things that are available from the import - -- Its domain is all the "main" things; - -- i.e. *excluding* class ops and constructors - -- (which appear inside their parent AvailTC) - - imp_qual :: ModuleEnv AvailEnv, - -- Used to figure out "module M" export specifiers + imp_env :: ModuleEnv NameSet, + -- All the things imported, classified by + -- the *module qualifier* for its import + -- e.g. import List as Foo + -- would add a binding Foo |-> ...stuff from List... + -- to imp_env. + -- + -- We need to classify them like this so that we can figure out + -- "module M" export specifiers in an export list -- (see 1.4 Report Section 5.1.1). Ultimately, we want to find -- everything that is unambiguously in scope as 'M.x' -- and where plain 'x' is (perhaps ambiguously) in scope. -- So the starting point is all things that are in scope as 'M.x', -- which is what this field tells us. - -- - -- Domain is the *module qualifier* for imports. - -- e.g. import List as Foo - -- would add a binding Foo |-> ...stuff from List... - -- to imp_qual. - -- We keep the stuff as an AvailEnv so that it's easy to - -- combine stuff coming from different (unqualified) - -- imports of the same module - imp_mods :: ModuleEnv (Module, Maybe Bool, SrcSpan), + imp_mods :: ModuleEnv (Module, Bool, SrcSpan), -- Domain is all directly-imported modules - -- Maybe value answers the question "is the import restricted?" - -- Nothing => unrestricted import (e.g., "import Foo") - -- Just True => restricted import, at least one entity (e.g., "import Foo(x)") - -- Just False => fully restricted import (e.g., "import Foo ()") - -- - -- A distinction is made between the first and the third in order - -- to more precisely emit warnings about unused imports. + -- Bool means: + -- True => import was "import Foo ()" + -- False => import was some other form -- -- We need the Module in the range because we can't get -- the keys of a ModuleEnv -- Used -- (a) to help construct the usage information in - -- the interface file; if we import everything we - -- need to recompile if the module version changes + -- the interface file; if we import somethign we + -- need to recompile if the export version changes -- (b) to specify what child modules to initialise - imp_dep_mods :: ModuleEnv (ModuleName, IsBootInterface), + imp_dep_mods :: ModuleEnv (Module, IsBootInterface), -- Home-package modules needed by the module being compiled -- - -- It doesn't matter whether any of these dependencies are actually - -- *used* when compiling the module; they are listed if they are below - -- it at all. For example, suppose M imports A which imports X. Then - -- compiling M might not need to consult X.hi, but X is still listed - -- in M's dependencies. - - imp_dep_pkgs :: [PackageName], + -- It doesn't matter whether any of these dependencies + -- are actually *used* when compiling the module; they + -- are listed if they are below it at all. For + -- example, suppose M imports A which imports X. Then + -- compiling M might not need to consult X.hi, but X + -- is still listed in M's dependencies. + + imp_dep_pkgs :: [PackageId], -- Packages needed by the module being compiled, whether -- directly, or via other modules in this package, or via -- modules imported from other packages. - imp_orphs :: [ModuleName] + imp_orphs :: [Module] -- Orphan modules below us in the import tree } -mkModDeps :: [(ModuleName, IsBootInterface)] - -> ModuleEnv (ModuleName, IsBootInterface) +mkModDeps :: [(Module, IsBootInterface)] + -> ModuleEnv (Module, IsBootInterface) mkModDeps deps = foldl add emptyModuleEnv deps where - add env elt@(m,_) = extendModuleEnvByName env m elt + add env elt@(m,_) = extendModuleEnv env m elt emptyImportAvails :: ImportAvails -emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv, - imp_qual = emptyModuleEnv, +emptyImportAvails = ImportAvails { imp_env = emptyModuleEnv, imp_mods = emptyModuleEnv, imp_dep_mods = emptyModuleEnv, imp_dep_pkgs = [], @@ -495,12 +533,11 @@ emptyImportAvails = ImportAvails { imp_env = emptyAvailEnv, plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails plusImportAvails - (ImportAvails { imp_env = env1, imp_qual = unqual1, imp_mods = mods1, + (ImportAvails { imp_env = env1, imp_mods = mods1, imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 }) - (ImportAvails { imp_env = env2, imp_qual = unqual2, imp_mods = mods2, + (ImportAvails { imp_env = env2, imp_mods = mods2, imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 }) - = ImportAvails { imp_env = env1 `plusAvailEnv` env2, - imp_qual = plusModuleEnv_C plusAvailEnv unqual1 unqual2, + = ImportAvails { imp_env = plusModuleEnv_C unionNameSets env1 env2, imp_mods = mods1 `plusModuleEnv` mods2, imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2, imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2, @@ -616,7 +653,7 @@ type Int, represented by \begin{code} data Inst = Dict - Id + Name TcPredType InstLoc @@ -637,8 +674,6 @@ data Inst TcThetaType -- The (types of the) dictionaries to which the function -- must be applied to get the method - TcTauType -- The tau-type of the method - InstLoc -- INVARIANT 1: in (Method u f tys theta tau loc) @@ -651,11 +686,12 @@ data Inst -- This only bites in the call to tcInstClassOp in TcClassDcl.mkMethodBind | LitInst - Id - HsOverLit -- The literal from the occurrence site - -- INVARIANT: never a rebindable-syntax literal - -- Reason: tcSyntaxName does unification, and we - -- don't want to deal with that during tcSimplify + Name + (HsOverLit Name) -- The literal from the occurrence site + -- INVARIANT: never a rebindable-syntax literal + -- Reason: tcSyntaxName does unification, and we + -- don't want to deal with that during tcSimplify, + -- when resolving LitInsts TcType -- The type at which the literal is used InstLoc \end{code} @@ -673,16 +709,16 @@ instance Eq Inst where EQ -> True other -> False -cmpInst (Dict _ pred1 _) (Dict _ pred2 _) = pred1 `tcCmpPred` pred2 -cmpInst (Dict _ _ _) other = LT +cmpInst (Dict _ pred1 _) (Dict _ pred2 _) = pred1 `tcCmpPred` pred2 +cmpInst (Dict _ _ _) other = LT -cmpInst (Method _ _ _ _ _ _) (Dict _ _ _) = GT -cmpInst (Method _ id1 tys1 _ _ _) (Method _ id2 tys2 _ _ _) = (id1 `compare` id2) `thenCmp` (tys1 `tcCmpTypes` tys2) -cmpInst (Method _ _ _ _ _ _) other = LT +cmpInst (Method _ _ _ _ _) (Dict _ _ _) = GT +cmpInst (Method _ id1 tys1 _ _) (Method _ id2 tys2 _ _) = (id1 `compare` id2) `thenCmp` (tys1 `tcCmpTypes` tys2) +cmpInst (Method _ _ _ _ _) other = LT -cmpInst (LitInst _ _ _ _) (Dict _ _ _) = GT -cmpInst (LitInst _ _ _ _) (Method _ _ _ _ _ _) = GT -cmpInst (LitInst _ lit1 ty1 _) (LitInst _ lit2 ty2 _) = (lit1 `compare` lit2) `thenCmp` (ty1 `tcCmpType` ty2) +cmpInst (LitInst _ _ _ _) (Dict _ _ _) = GT +cmpInst (LitInst _ _ _ _) (Method _ _ _ _ _) = GT +cmpInst (LitInst _ lit1 ty1 _) (LitInst _ lit2 ty2 _) = (lit1 `compare` lit2) `thenCmp` (ty1 `tcCmpType` ty2) \end{code} @@ -693,6 +729,7 @@ cmpInst (LitInst _ lit1 ty1 _) (LitInst _ lit2 ty2 _) = (lit1 `compare` lit %************************************************************************ \begin{code} +-- FIXME: Rename this. It clashes with (Located (IE ...)) type LIE = Bag Inst isEmptyLIE = isEmptyBag @@ -743,7 +780,7 @@ data InstOrigin | IPOccOrigin (IPName Name) -- Occurrence of an implicit parameter - | LiteralOrigin HsOverLit -- Occurrence of a literal + | LiteralOrigin (HsOverLit Name) -- Occurrence of a literal | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc | PArrSeqOrigin (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:] @@ -761,8 +798,6 @@ data InstOrigin \begin{code} pprInstLoc :: InstLoc -> SDoc -pprInstLoc (InstLoc (SigOrigin info) locn _) - = text "arising from" <+> ppr info -- I don't think this happens much, if at all pprInstLoc (InstLoc orig locn _) = hsep [text "arising from", pp_orig orig, text "at", ppr locn] where @@ -773,11 +808,11 @@ pprInstLoc (InstLoc orig locn _) pp_orig (LiteralOrigin lit) = hsep [ptext SLIT("the literal"), quotes (ppr lit)] pp_orig (ArithSeqOrigin seq) = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)] pp_orig (PArrSeqOrigin seq) = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)] - pp_orig InstSigOrigin = ptext SLIT("instantiating a type signature") - pp_orig InstScOrigin = ptext SLIT("the superclasses of an instance declaration") + pp_orig InstSigOrigin = ptext SLIT("instantiating a type signature") + pp_orig InstScOrigin = ptext SLIT("the superclasses of an instance declaration") pp_orig DerivOrigin = ptext SLIT("the 'deriving' clause of a data type declaration") pp_orig DefaultOrigin = ptext SLIT("a 'default' declaration") - pp_orig DoOrigin = ptext SLIT("a do statement") - pp_orig ProcOrigin = ptext SLIT("a proc expression") - pp_orig (SigOrigin info) = ppr info + pp_orig DoOrigin = ptext SLIT("a do statement") + pp_orig ProcOrigin = ptext SLIT("a proc expression") + pp_orig (SigOrigin info) = pprSkolInfo info \end{code}