X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnTypes.lhs;h=3f347913b8d81764f4a9dea50b946aca6913fd88;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=01dbce13409b4be3fc1fc637077c653d2a16c2f9;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs index 01dbce1..3f34791 100644 --- a/ghc/compiler/typecheck/TcRnTypes.lhs +++ b/ghc/compiler/typecheck/TcRnTypes.lhs @@ -30,7 +30,8 @@ module TcRnTypes( ArrowCtxt(..), topArrowCtxt, ProcLevel, topProcLevel, -- Insts - Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, instLocSrcLoc, + Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, + instLocSrcLoc, instLocSrcSpan, LIE, emptyLIE, unitLIE, plusLIE, consLIE, plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE, @@ -40,8 +41,8 @@ module TcRnTypes( #include "HsVersions.h" -import HsSyn ( PendingSplice, HsOverLit, MonoBinds, RuleDecl, ForeignDecl ) -import RnHsSyn ( RenamedPat, RenamedArithSeqInfo ) +import HsSyn ( PendingSplice, HsOverLit, LHsBind, LRuleDecl, LForeignDecl, + Pat, ArithSeqInfo ) import HscTypes ( FixityEnv, HscEnv, TypeEnv, TyThing, Avails, GenAvailInfo(..), AvailInfo, @@ -61,7 +62,7 @@ import Class ( Class ) import Var ( Id, TyVar ) import VarEnv ( TidyEnv ) import Module -import SrcLoc ( SrcLoc ) +import SrcLoc ( SrcSpan, SrcLoc, srcSpanStart ) import VarSet ( IdSet ) import ErrUtils ( Messages, Message ) import UniqSupply ( UniqSupply ) @@ -155,28 +156,42 @@ data TcGblEnv -- 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 -- with the rest of the info from this module. - tcg_exports :: Avails, -- What is exported - tcg_imports :: ImportAvails, -- Information about what was imported - -- from where, including things bound - -- in this module + tcg_exports :: NameSet, -- What is exported + tcg_imports :: ImportAvails, -- Information about what was imported + -- from where, including things bound + -- in this module + 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. + -- 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_binds :: MonoBinds Id, -- Value bindings in this module + tcg_binds :: Bag (LHsBind Id), -- Value bindings in this module tcg_deprecs :: Deprecations, -- ...Deprecations tcg_insts :: [DFunId], -- ...Instances - tcg_rules :: [RuleDecl Id], -- ...Rules - tcg_fords :: [ForeignDecl Id] -- ...Foreign import & exports + tcg_rules :: [LRuleDecl Id], -- ...Rules + tcg_fords :: [LForeignDecl Id] -- ...Foreign import & exports } \end{code} @@ -246,7 +261,7 @@ Why? Because they are now Ids not TcIds. This final GlobalEnv is data TcLclEnv -- Changes as we move inside an expression -- Discarded after typecheck/rename; not passed on to desugarer = TcLclEnv { - tcl_loc :: SrcLoc, -- Source location + tcl_loc :: SrcSpan, -- Source span tcl_ctxt :: ErrCtxt, -- Error context tcl_errs :: TcRef Messages, -- Place to accumulate errors @@ -254,6 +269,10 @@ data TcLclEnv -- Changes as we move inside an expression tcl_arrow_ctxt :: ArrowCtxt, -- Arrow-notation context tcl_rdr :: LocalRdrEnv, -- Local name envt + -- Maintained during renaming, of course, but also during + -- type checking, solely so that when renaming a Template-Haskell + -- splice we have the right environment for the renamer. + -- -- Does *not* include global name envt; may shadow it -- Includes both ordinary variables and type variables; -- they are kept distinct because tyvar have a different @@ -341,15 +360,14 @@ 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 - | ARecTyCon TcKind -- Used temporarily, during kind checking, for the - | ARecClass TcKind -- tycons and clases in this recursive group + | 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 (ARecTyCon k) = text "ARecTyCon" <+> ppr k - ppr (ARecClass k) = text "ARecClass" <+> ppr k + ppr (AThing k) = text "AThing" <+> ppr k \end{code} \begin{code} @@ -425,7 +443,7 @@ data ImportAvails -- combine stuff coming from different (unqualified) -- imports of the same module - imp_mods :: ModuleEnv (Module, Maybe Bool), + imp_mods :: ModuleEnv (Module, Maybe Bool, SrcSpan), -- Domain is all directly-imported modules -- Maybe value answers the question "is the import restricted?" -- Nothing => unrestricted import (e.g., "import Foo") @@ -703,16 +721,19 @@ It appears in TcMonad because there are a couple of error-message-generation functions that deal with it. \begin{code} -data InstLoc = InstLoc InstOrigin SrcLoc ErrCtxt +data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt instLocSrcLoc :: InstLoc -> SrcLoc -instLocSrcLoc (InstLoc _ src_loc _) = src_loc +instLocSrcLoc (InstLoc _ src_span _) = srcSpanStart src_span + +instLocSrcSpan :: InstLoc -> SrcSpan +instLocSrcSpan (InstLoc _ src_span _) = src_span data InstOrigin = OccurrenceOf Name -- Occurrence of an overloaded identifier - | IPOcc (IPName Name) -- Occurrence of an implicit parameter - | IPBind (IPName Name) -- Binding site of an implicit parameter + | IPOccOrigin (IPName Name) -- Occurrence of an implicit parameter + | IPBindOrigin (IPName Name) -- Binding site of an implicit parameter | RecordUpdOrigin @@ -722,10 +743,10 @@ data InstOrigin | LiteralOrigin HsOverLit -- Occurrence of a literal - | PatOrigin RenamedPat + | PatOrigin (Pat Name) - | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc - | PArrSeqOrigin RenamedArithSeqInfo -- [:x..y:] and [:x,y..z:] + | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc + | PArrSeqOrigin (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:] | SignatureOrigin -- A dict created from a type signature | Rank2Origin -- A dict created when typechecking the argument @@ -761,9 +782,9 @@ pprInstLoc (InstLoc orig locn ctxt) where pp_orig (OccurrenceOf name) = hsep [ptext SLIT("use of"), quotes (ppr name)] - pp_orig (IPOcc name) + pp_orig (IPOccOrigin name) = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)] - pp_orig (IPBind name) + pp_orig (IPBindOrigin name) = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)] pp_orig RecordUpdOrigin = ptext SLIT("a record update")