X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=746a30bab3f13cb4b1c13a40cfcf68e20b0412a5;hp=c8d75509a3909714877e5f10de159d823e15d469;hb=90686adf9d3dc7a09a51853df051bc4ea472d840;hpb=7bb3d1fc79521d591cd9f824893963141a7997b6 diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index c8d7550..746a30b 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, @@ -68,8 +68,6 @@ import Outputable import ListSetOps import FastString -import Data.Maybe -import Data.List import Data.Set (Set) \end{code} @@ -224,14 +222,8 @@ 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 @@ -241,7 +233,11 @@ data TcGblEnv 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), + -- The set of used *imported* (not locally-defined) RdrNames + -- Used only to report unused import declarations + tcg_rn_decls :: Maybe (HsGroup Name), -- ^ Renamed decls, maybe. @Nothing@ <=> Don't retain renamed -- decls. @@ -254,10 +250,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 @@ -341,7 +340,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 @@ -391,37 +390,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 @@ -524,10 +541,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} @@ -884,7 +904,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