X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=fd7e954b743a07fdc91e34b473ae24fb023e4f39;hb=1fede4bc9501744bf2269ce2a4cb9fb735969caa;hp=ff8e3d630752d5b52bed1302b2a9010029acb082;hpb=bb3a29ba8290a6c19602734a56ba0f414f02c289;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index ff8e3d6..fd7e954 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -29,12 +29,12 @@ module TcRnTypes( -- Insts Inst(..), EqInstCo, InstOrigin(..), InstLoc(..), - pprInstLoc, pprInstArising, instLocSpan, instLocOrigin, + pprInstLoc, pprInstArising, instLocSpan, instLocOrigin, setInstLoc, LIE, emptyLIE, unitLIE, plusLIE, consLIE, instLoc, instSpan, 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. @@ -325,7 +333,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 +351,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 } @@ -503,10 +516,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,11 +879,14 @@ 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 +setInstLoc :: Inst -> InstLoc -> Inst +setInstLoc inst new_loc = inst { tci_loc = new_loc } + instSpan :: Inst -> SrcSpan instSpan wanted = instLocSpan (instLoc wanted) @@ -912,7 +931,13 @@ data InstOrigin | ExprSigOrigin -- e :: ty | RecordUpdOrigin | ViewPatOrigin + | InstScOrigin -- Typechecking superclasses of an instance declaration + + | NoScOrigin -- A very special hack; see TcSimplify, + -- Note [Recursive instances and superclases] + + | DerivOrigin -- Typechecking deriving | StandAloneDerivOrigin -- Typechecking stand-alone deriving | DefaultOrigin -- Typechecking a default decl @@ -936,6 +961,7 @@ instance Outputable InstOrigin where ppr TupleOrigin = ptext (sLit "a tuple") ppr NegateOrigin = ptext (sLit "a use of syntactic negation") ppr InstScOrigin = ptext (sLit "the superclasses of an instance declaration") + ppr NoScOrigin = ptext (sLit "an instance declaration") ppr DerivOrigin = ptext (sLit "the 'deriving' clause of a data type declaration") ppr StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration") ppr DefaultOrigin = ptext (sLit "a 'default' declaration")