% (c) The GRASP Project, Glasgow University, 1992-2002
%
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module TcRnTypes(
TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module
TcRef,
IfGblEnv(..), IfLclEnv(..),
-- Ranamer types
- ErrCtxt, RecFieldEnv,
+ ErrCtxt, RecFieldEnv(..),
ImportAvails(..), emptyImportAvails, plusImportAvails,
WhereFrom(..), mkModDeps,
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,
import HsSyn hiding (LIE)
import HscTypes
-import Packages
import Type
import Coercion
import TcType
import Bag
import Outputable
import ListSetOps
-import FiniteMap
import FastString
import Data.Maybe
-- 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_insts :: [Instance], -- ...Instances
tcg_fam_insts :: [FamInst], -- ...Family instances
tcg_rules :: [LRuleDecl Id], -- ...Rules
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}
%************************************************************************
\begin{code}
data ImportAvails
= ImportAvails {
- imp_mods :: ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]),
+ imp_mods :: ModuleEnv [(ModuleName, Bool, SrcSpan)],
-- Domain is all directly-imported modules
-- The ModuleName is what the module was imported as, e.g. in
-- import Foo as Bar
-- 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 somethign we
(ImportAvails { imp_mods = mods2,
imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
imp_orphs = orphs2, imp_finsts = finsts2 })
- = ImportAvails { imp_mods = plusModuleEnv_C plus_mod mods1 mods2,
+ = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2,
imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
imp_orphs = orphs1 `unionLists` orphs2,
imp_finsts = finsts1 `unionLists` finsts2 }
where
- plus_mod (m1, xs1) (_, xs2) = (m1, xs1 ++ xs2)
plus_mod_dep (m1, boot1) (m2, boot2)
= WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
-- Check mod-names match
data Inst
= Dict {
tci_name :: Name,
- tci_pred :: TcPredType,
+ tci_pred :: TcPredType, -- Class or implicit parameter only
tci_loc :: InstLoc
}
-- 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
\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
- EQ -> True
- other -> False
+ EQ -> True
+ _ -> False
+cmpInst :: Inst -> Inst -> Ordering
cmpInst d1@(Dict {}) d2@(Dict {}) = tci_pred d1 `tcCmpPred` tci_pred d2
-cmpInst (Dict {}) other = LT
+cmpInst (Dict {}) _ = LT
cmpInst (Method {}) (Dict {}) = GT
cmpInst m1@(Method {}) m2@(Method {}) = (tci_oid m1 `compare` tci_oid m2) `thenCmp`
(tci_tys m1 `tcCmpTypes` tci_tys m2)
-cmpInst (Method {}) other = LT
+cmpInst (Method {}) _ = LT
cmpInst (LitInst {}) (Dict {}) = GT
cmpInst (LitInst {}) (Method {}) = GT
cmpInst l1@(LitInst {}) l2@(LitInst {}) = (tci_lit l1 `compare` tci_lit l2) `thenCmp`
(tci_ty l1 `tcCmpType` tci_ty l2)
-cmpInst (LitInst {}) other = LT
+cmpInst (LitInst {}) _ = LT
-- Implication constraints are compared by *name*
-- not by type; that is, we make no attempt to do CSE on them
cmpInst (ImplicInst {}) (Method {}) = GT
cmpInst (ImplicInst {}) (LitInst {}) = GT
cmpInst i1@(ImplicInst {}) i2@(ImplicInst {}) = tci_name i1 `compare` tci_name i2
-cmpInst (ImplicInst {}) other = LT
+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}
-- FIXME: Rename this. It clashes with (Located (IE ...))
type LIE = Bag Inst
-isEmptyLIE = isEmptyBag
-emptyLIE = emptyBag
-unitLIE inst = unitBag inst
-mkLIE insts = listToBag insts
+isEmptyLIE :: LIE -> Bool
+isEmptyLIE = isEmptyBag
+
+emptyLIE :: LIE
+emptyLIE = emptyBag
+
+unitLIE :: Inst -> LIE
+unitLIE inst = unitBag inst
+
+mkLIE :: [Inst] -> LIE
+mkLIE insts = listToBag insts
+
+plusLIE :: LIE -> LIE -> LIE
plusLIE lie1 lie2 = lie1 `unionBags` lie2
-plusLIEs lies = unionManyBags lies
-lieToList = bagToList
-listToLIE = listToBag
+plusLIEs :: [LIE] -> LIE
+plusLIEs lies = unionManyBags lies
+
+lieToList :: LIE -> [Inst]
+lieToList = bagToList
+
+listToLIE :: [Inst] -> LIE
+listToLIE = listToBag
+
+consLIE :: Inst -> LIE -> LIE
consLIE inst lie = lie `snocBag` inst
-- Putting the new Inst at the *end* of the bag is a half-hearted attempt
-- to ensure that we tend to report the *leftmost* type-constraint error
ppr (ImplicOrigin doc) = doc
ppr (SigOrigin info) = pprSkolInfo info
ppr EqOrigin = ptext (sLit "a type equality")
+ ppr InstSigOrigin = panic "ppr InstSigOrigin"
\end{code}
projects / ghc-hetmet.git / blobdiff