X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=a91e95e377ae504e9ef2aa82ada65bd88b209670;hp=28bfd8ecb72a8d7c3e35335f1263367334ca1868;hb=46c673a70fe14fe05d7160b456925b8591b5f779;hpb=c04a5fe3e2867d59ce9757069fdd20c06c326724 diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 28bfd8e..a91e95e 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -22,7 +22,7 @@ module TcRnTypes( -- Template Haskell ThStage(..), topStage, topAnnStage, topSpliceStage, - ThLevel, impLevel, topLevel, + ThLevel, impLevel, outerLevel, thLevel, -- Arrows ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope, @@ -34,7 +34,7 @@ module TcRnTypes( plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE, -- Misc other types - TcId, TcIdSet, TcDictBinds, + TcId, TcIdSet, TcDictBinds, TcTyVarBind(..), TcTyVarBinds ) where @@ -68,8 +68,7 @@ import Outputable import ListSetOps import FastString -import Data.Maybe -import Data.List +import Data.Set (Set) \end{code} @@ -98,6 +97,18 @@ type RnM a = TcRn a -- Historical type TcM a = TcRn a -- Historical \end{code} +Representation of type bindings to uninstantiated meta variables used during +constraint solving. + +\begin{code} +data TcTyVarBind = TcTyVarBind TcTyVar TcType + +type TcTyVarBinds = Bag TcTyVarBind + +instance Outputable TcTyVarBind where + ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty +\end{code} + %************************************************************************ %* * @@ -211,21 +222,18 @@ data TcGblEnv -- 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). + tcg_dfun_n :: TcRef OccSet, + -- ^ Allows us to choose unique DFun names. -- 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_imports :: [LImportDecl Name], + -- Keep the renamed imports regardless. They are not + -- voluminous and are needed if you want to report unused imports + tcg_used_rdrnames :: TcRef (Set RdrName), tcg_rn_decls :: Maybe (HsGroup Name), -- ^ Renamed decls, maybe. @Nothing@ <=> Don't retain renamed -- decls. @@ -238,10 +246,13 @@ data TcGblEnv tcg_rules :: [LRuleDecl Id], -- ...Rules tcg_fords :: [LForeignDecl Id], -- ...Foreign import & exports - tcg_doc :: Maybe (HsDoc Name), -- ^ Maybe Haddock documentation - tcg_hmi :: HaddockModInfo Name, -- ^ Haddock module information - tcg_hpc :: AnyHpcUsage -- ^ @True@ if any part of the prog uses hpc - -- instrumentation. + tcg_doc_hdr :: Maybe LHsDocString, -- ^ Maybe Haddock header docs + tcg_hpc :: AnyHpcUsage, -- ^ @True@ if any part of the + -- prog uses hpc instrumentation. + + tcg_main :: Maybe Name -- ^ The Name of the main + -- function, if this module is + -- the main module. } data RecFieldEnv @@ -325,7 +336,7 @@ data TcLclEnv -- Changes as we move inside an expression -- Discarded after typecheck/rename; not passed on to desugarer = TcLclEnv { tcl_loc :: SrcSpan, -- Source span - tcl_ctxt :: ErrCtxt, -- Error context + tcl_ctxt :: [ErrCtxt], -- Error context, innermost on top tcl_errs :: TcRef Messages, -- Place to accumulate errors tcl_th_ctxt :: ThStage, -- Template Haskell context @@ -343,15 +354,20 @@ data TcLclEnv -- Changes as we move inside an expression -- We still need the unsullied global name env so that -- we can look up record field names - tcl_env :: NameEnv TcTyThing, -- The local type environment: Ids and TyVars - -- defined in this module + tcl_env :: NameEnv TcTyThing, -- The local type environment: Ids and + -- TyVars defined in this module tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars" -- 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 + -- 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 + tcl_tybinds :: TcRef TcTyVarBinds -- Meta and coercion type variable + -- bindings accumulated during + -- constraint solving } @@ -370,37 +386,55 @@ pass it inwards. -} --------------------------- --- Template Haskell levels +-- Template Haskell stages and levels --------------------------- +data ThStage -- See Note [Template Haskell state diagram] in TcSplice + = Splice -- Top-level splicing + -- This code will be run *at compile time*; + -- the result replaces the splice + -- Binding level = 0 + + | Comp -- Ordinary Haskell code + -- Binding level = 1 + + | Brack -- Inside brackets + ThStage -- Binding level = level(stage) + 1 + (TcRef [PendingSplice]) -- Accumulate pending splices here + (TcRef LIE) -- and type constraints here + +topStage, topAnnStage, topSpliceStage :: ThStage +topStage = Comp +topAnnStage = Splice +topSpliceStage = Splice + +instance Outputable ThStage where + ppr Splice = text "Splice" + ppr Comp = text "Comp" + ppr (Brack s _ _) = text "Brack" <> parens (ppr s) + type ThLevel = Int - -- Indicates how many levels of brackets we are inside - -- (always >= 0) + -- See Note [Template Haskell levels] in TcSplice -- Incremented when going inside a bracket, -- decremented when going inside a splice -- NB: ThLevel is one greater than the 'n' in Fig 2 of the -- original "Template meta-programming for Haskell" paper -impLevel, topLevel :: ThLevel -topLevel = 1 -- Things defined at top level of this module +impLevel, outerLevel :: ThLevel impLevel = 0 -- Imported things; they can be used inside a top level splice +outerLevel = 1 -- Things defined outside brackets +-- NB: Things at level 0 are not *necessarily* imported. +-- eg $( \b -> ... ) here b is bound at level 0 -- -- For example: -- f = ... -- g1 = $(map ...) is OK -- g2 = $(f ...) is not OK; because we havn't compiled f yet - -data ThStage - = Comp ThLevel -- Ordinary compiling, usually at level topLevel but annotations use a lower level - | Splice ThLevel -- Inside a splice - | Brack ThLevel -- Inside brackets; - (TcRef [PendingSplice]) -- accumulate pending splices here - (TcRef LIE) -- and type constraints here -topStage, topAnnStage, topSpliceStage :: ThStage -topStage = Comp topLevel -topAnnStage = Comp (topLevel - 1) -topSpliceStage = Splice (topLevel - 1) -- Stage for the body of a top-level splice +thLevel :: ThStage -> ThLevel +thLevel Splice = 0 +thLevel Comp = 1 +thLevel (Brack s _ _) = thLevel s + 1 --------------------------- -- Arrow-notation context @@ -503,10 +537,13 @@ instance Outputable RefinementVisibility where \end{code} \begin{code} -type ErrCtxt = [TidyEnv -> TcM (TidyEnv, Message)] - -- Innermost first. Monadic so that we have a chance - -- to deal with bound type variables just before error - -- message construction +type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, Message)) + -- Monadic so that we have a chance + -- to deal with bound type variables just before error + -- message construction + + -- Bool: True <=> this is a landmark context; do not + -- discard it when trimming for display \end{code} @@ -863,7 +900,7 @@ functions that deal with it. \begin{code} ------------------------------------------- -data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt +data InstLoc = InstLoc InstOrigin SrcSpan [ErrCtxt] instLoc :: Inst -> InstLoc instLoc inst = tci_loc inst