X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=c48cd8b75f0029f45e0f7d4c260f70d22e9c269e;hb=6976a7121afdb4c154afbe636c315cc9595eaf00;hp=20262c968e256ecb7d51799f00c39ccee5187d84;hpb=0ffd1de9f595340f18cb94d57c99ded44826455d;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 20262c9..c48cd8b 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -13,7 +13,7 @@ module TcRnTypes( IfGblEnv(..), IfLclEnv(..), -- Ranamer types - ErrCtxt, RecFieldEnv, + ErrCtxt, RecFieldEnv(..), ImportAvails(..), emptyImportAvails, plusImportAvails, WhereFrom(..), mkModDeps, @@ -21,14 +21,14 @@ module TcRnTypes( TcTyThing(..), pprTcTyThingCategory, RefinementVisibility(..), -- Template Haskell - ThStage(..), topStage, topSpliceStage, + ThStage(..), topStage, topAnnStage, topSpliceStage, ThLevel, impLevel, topLevel, -- Arrows ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope, -- Insts - Inst(..), InstOrigin(..), InstLoc(..), + Inst(..), EqInstCo, InstOrigin(..), InstLoc(..), pprInstLoc, pprInstArising, instLocSpan, instLocOrigin, LIE, emptyLIE, unitLIE, plusLIE, consLIE, instLoc, instSpan, plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE, @@ -45,6 +45,7 @@ import HscTypes import Type import Coercion import TcType +import Annotations import InstEnv import FamInstEnv import IOEnv @@ -208,18 +209,14 @@ data TcGblEnv -- 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_imports :: Maybe [LImportDecl Name], tcg_rn_exports :: Maybe [Located (IE Name)], 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_warns :: Warnings, -- ...Warnings and deprecations + tcg_anns :: [Annotation], -- ...Annotations tcg_insts :: [Instance], -- ...Instances tcg_fam_insts :: [FamInst], -- ...Family instances tcg_rules :: [LRuleDecl Id], -- ...Rules @@ -230,13 +227,18 @@ data TcGblEnv tcg_hpc :: AnyHpcUsage -- True if any part of the prog uses hpc instrumentation. } -type RecFieldEnv = NameEnv [Name] -- Maps a constructor name *in this module* - -- to the fields for that constructor +data RecFieldEnv + = RecFields (NameEnv [Name]) -- Maps a constructor name *in this module* + -- to the fields for that constructor + NameSet -- Set of all fields declared *in this module*; + -- used to suppress name-shadowing complaints + -- when using record wild cards + -- E.g. let fld = e in C {..} -- This is used when dealing with ".." notation in record -- construction and pattern matching. - -- The FieldEnv deals *only* with constructors defined in - -- *thie* module. For imported modules, we get the same info - -- from the TypeEnv + -- The FieldEnv deals *only* with constructors defined in *this* + -- module. For imported modules, we get the same info from the + -- TypeEnv \end{code} %************************************************************************ @@ -373,13 +375,14 @@ impLevel = 0 -- Imported things; they can be used inside a top level splice data ThStage - = Comp -- Ordinary compiling, at level topLevel + = 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, topSpliceStage :: ThStage -topStage = Comp +topStage, topAnnStage, topSpliceStage :: ThStage +topStage = Comp topLevel +topAnnStage = Comp (topLevel - 1) topSpliceStage = Splice (topLevel - 1) -- Stage for the body of a top-level splice --------------------------- @@ -638,7 +641,7 @@ I am not convinced that this duplication is necessary or useful! -=chak data Inst = Dict { tci_name :: Name, - tci_pred :: TcPredType, + tci_pred :: TcPredType, -- Class or implicit parameter only tci_loc :: InstLoc } @@ -700,27 +703,26 @@ data Inst -- co :: ty1 ~ ty2 tci_left :: TcType, -- ty1 -- both types are... tci_right :: TcType, -- ty2 -- ...free of boxes - tci_co :: Either -- co - TcTyVar -- - a wanted equation, with a hole, to be - -- filled with a witness for the equality; - -- for equation arising from deferring - -- unification, 'ty1' is the actual and - -- 'ty2' the expected type - Coercion, -- - a given equation, with a coercion - -- witnessing the equality; - -- a coercion that originates from a - -- signature or a GADT is a CoVar, but - -- after normalisation of coercions, they - -- can be arbitrary Coercions involving - -- constructors and pseudo-constructors - -- like sym and trans. + tci_co :: EqInstCo, -- co tci_loc :: InstLoc, tci_name :: Name -- Debugging help only: this makes it easier to -- follow where a constraint is used in a morass - -- of trace messages! Unlike other Insts, it has - -- no semantic significance whatsoever. + -- of trace messages! Unlike other Insts, it + -- has no semantic significance whatsoever. } + +type EqInstCo = Either -- Distinguish between given and wanted coercions + TcTyVar -- - a wanted equation, with a hole, to be filled + -- with a witness for the equality; for equation + -- arising from deferring unification, 'ty1' is + -- the actual and 'ty2' the expected type + Coercion -- - a given equation, with a coercion witnessing + -- the equality; a coercion that originates + -- from a signature or a GADT is a CoVar, but + -- after normalisation of coercions, they can + -- be arbitrary Coercions involving constructors + -- and pseudo-constructors like sym and trans. \end{code} @Insts@ are ordered by their class/type info, rather than by their @@ -730,7 +732,8 @@ than with the Avails handling stuff in TcSimplify \begin{code} instance Ord Inst where - compare = cmpInst + compare = cmpInst + -- Used *only* for AvailEnv in TcSimplify instance Eq Inst where (==) i1 i2 = case i1 `cmpInst` i2 of @@ -761,11 +764,12 @@ cmpInst i1@(ImplicInst {}) i2@(ImplicInst {}) = tci_name i1 `compare` tci_name i cmpInst (ImplicInst {}) _ = LT -- same for Equality constraints -cmpInst (EqInst {}) (Dict {}) = GT -cmpInst (EqInst {}) (Method {}) = GT -cmpInst (EqInst {}) (LitInst {}) = GT -cmpInst (EqInst {}) (ImplicInst {}) = GT -cmpInst i1@(EqInst {}) i2@(EqInst {}) = tci_name i1 `compare` tci_name i2 +cmpInst (EqInst {}) (Dict {}) = GT +cmpInst (EqInst {}) (Method {}) = GT +cmpInst (EqInst {}) (LitInst {}) = GT +cmpInst (EqInst {}) (ImplicInst {}) = GT +cmpInst i1@(EqInst {}) i2@(EqInst {}) = (tci_left i1 `tcCmpType` tci_left i2) `thenCmp` + (tci_right i1 `tcCmpType` tci_right i2) \end{code} @@ -889,6 +893,7 @@ data InstOrigin | ProcOrigin -- Arising from a proc expression | ImplicOrigin SDoc -- An implication constraint | EqOrigin -- A type equality + | AnnOrigin -- An annotation instance Outputable InstOrigin where ppr (OccurrenceOf name) = hsep [ptext (sLit "a use of"), quotes (ppr name)] @@ -913,4 +918,5 @@ instance Outputable InstOrigin where ppr (SigOrigin info) = pprSkolInfo info ppr EqOrigin = ptext (sLit "a type equality") ppr InstSigOrigin = panic "ppr InstSigOrigin" + ppr AnnOrigin = ptext (sLit "an annotation") \end{code}