X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnTypes.lhs;h=e8b0b4818144e03191786bdb8f2ac272695084f1;hb=70cfef77ff00fbd4a57f733045e62ce0a7ba1307;hp=f9f92755e1305ea92ab0675af8ecad2680d70a38;hpb=d551dbfef0b710f5ede21ee0c54ee7e80dd53b64;p=ghc-hetmet.git diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs index f9f9275..e8b0b48 100644 --- a/ghc/compiler/typecheck/TcRnTypes.lhs +++ b/ghc/compiler/typecheck/TcRnTypes.lhs @@ -27,7 +27,7 @@ module TcRnTypes( ThLevel, impLevel, topLevel, -- Arrows - ArrowCtxt(..), topArrowCtxt, ProcLevel, topProcLevel, + ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope, -- Insts Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, @@ -42,16 +42,16 @@ module TcRnTypes( #include "HsVersions.h" import HsSyn ( PendingSplice, HsOverLit, LRuleDecl, LForeignDecl, - ArithSeqInfo, DictBinds, LHsBinds ) + ArithSeqInfo, DictBinds, LHsBinds, HsGroup ) import HscTypes ( FixityEnv, HscEnv, TypeEnv, TyThing, GenAvailInfo(..), AvailInfo, HscSource(..), availName, IsBootInterface, Deprecations ) -import Packages ( PackageId ) +import Packages ( PackageId, HomeModules ) import Type ( Type, TvSubstEnv, pprParendType, pprTyThingCategory ) import TcType ( TcTyVarSet, TcType, TcTauType, TcThetaType, SkolemInfo, TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes, pprSkolInfo ) -import InstEnv ( DFunId, InstEnv ) +import InstEnv ( Instance, InstEnv ) import IOEnv import RdrName ( GlobalRdrEnv, LocalRdrEnv ) import Name ( Name ) @@ -162,6 +162,10 @@ 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 @@ -196,12 +200,28 @@ data TcGblEnv -- 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_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 } @@ -355,42 +375,45 @@ topStage, topSpliceStage :: ThStage topStage = Comp topSpliceStage = Splice (topLevel - 1) -- Stage for the body of a top-level splice - --------------------------- --- Arrow-notation stages +-- Arrow-notation context --------------------------- --- 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) --- --- 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 --- proc 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, and increment the proc-level so that variables --- bound inside the expression are in scope. --- d) When looking up a variable, complain if its proc-level is in --- the banned list - -type ProcLevel = Int -- Always >= 0 -topProcLevel = 0 -- Not inside any proc - -data ArrowCtxt = ArrCtxt { proc_level :: ProcLevel, -- Current level - proc_banned :: [ProcLevel] } -- Out of scope proc-levels - -topArrowCtxt = ArrCtxt { proc_level = topProcLevel, proc_banned = [] } +{- +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) + +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 + 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 (|..|). +-} + +data ArrowCtxt + = NoArrowCtxt + | ArrowCtxt (Env TcGblEnv TcLclEnv) + +-- 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 } } + +-- 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 @@ -399,7 +422,7 @@ topArrowCtxt = ArrCtxt { proc_level = topProcLevel, proc_banned = [] } 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 + | ATcId TcId ThLevel -- Ids defined in this module; may not be fully zonked | ATyVar Name TcType -- Type variables; tv -> type. It can't just be a TyVar -- that is mutated to point to the type it is bound to, @@ -412,15 +435,15 @@ data TcTyThing instance Outputable TcTyThing where -- Debugging only ppr (AGlobal g) = ppr g - ppr (ATcId g tl pl) = text "Identifier" <> - ifPprDebug (brackets (ppr g <> comma <> ppr tl <> comma <> ppr pl)) + ppr (ATcId g tl) = text "Identifier" <> + ifPprDebug (brackets (ppr g <> comma <> ppr tl)) ppr (ATyVar tv ty) = text "Type variable" <+> quotes (ppr tv) <+> pprParendType ty 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 (ATcId _ _) = ptext SLIT("Local identifier") pprTcTyThingCategory (AThing _) = ptext SLIT("Kinded thing") \end{code} @@ -464,22 +487,18 @@ data ImportAvails -- So the starting point is all things that are in scope as 'M.x', -- which is what this field tells us. - 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 (Module, IsBootInterface),