PageRenderTime 80ms CodeModel.GetById 26ms RepoModel.GetById 1ms app.codeStats 0ms

/compiler/typecheck/TcRnTypes.lhs

https://bitbucket.org/carter/ghc
Haskell | 1555 lines | 909 code | 276 blank | 370 comment | 20 complexity | d0833a99a85f9324c3ab6b0773972669 MD5 | raw file

Large files files are truncated, but you can click here to view the full file

  1. % (c) The University of Glasgow 2006
  2. % (c) The GRASP Project, Glasgow University, 1992-2002
  3. %
  4. Various types used during typechecking, please see TcRnMonad as well for
  5. operations on these types. You probably want to import it, instead of this
  6. module.
  7. All the monads exported here are built on top of the same IOEnv monad. The
  8. monad functions like a Reader monad in the way it passes the environment
  9. around. This is done to allow the environment to be manipulated in a stack
  10. like fashion when entering expressions... ect.
  11. For state that is global and should be returned at the end (e.g not part
  12. of the stack mechanism), you should use an TcRef (= IORef) to store them.
  13. \begin{code}
  14. {-# OPTIONS -fno-warn-tabs #-}
  15. -- The above warning supression flag is a temporary kludge.
  16. -- While working on this module you are encouraged to remove it and
  17. -- detab the module (please do the detabbing in a separate patch). See
  18. -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
  19. -- for details
  20. module TcRnTypes(
  21. TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module
  22. TcRef,
  23. -- The environment types
  24. Env(..),
  25. TcGblEnv(..), TcLclEnv(..),
  26. IfGblEnv(..), IfLclEnv(..),
  27. -- Ranamer types
  28. ErrCtxt, RecFieldEnv(..),
  29. ImportAvails(..), emptyImportAvails, plusImportAvails,
  30. WhereFrom(..), mkModDeps,
  31. -- Typechecker types
  32. TcTypeEnv, TcIdBinder(..), TcTyThing(..), PromotionErr(..),
  33. pprTcTyThingCategory, pprPECategory,
  34. -- Template Haskell
  35. ThStage(..), topStage, topAnnStage, topSpliceStage,
  36. ThLevel, impLevel, outerLevel, thLevel,
  37. -- Arrows
  38. ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
  39. -- Canonical constraints
  40. Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, dropDerivedWC,
  41. singleCt, extendCts, isEmptyCts, isCTyEqCan, isCFunEqCan,
  42. isCDictCan_Maybe, isCFunEqCan_Maybe,
  43. isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt,
  44. isGivenCt, isHoleCt,
  45. ctEvidence,
  46. SubGoalDepth, mkNonCanonical, mkNonCanonicalCt,
  47. ctPred, ctEvPred, ctEvTerm, ctEvId,
  48. WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
  49. andWC, unionsWC, addFlats, addImplics, mkFlatWC, addInsols,
  50. Implication(..),
  51. CtLoc(..), ctLocSpan, ctLocEnv, ctLocOrigin,
  52. ctLocDepth, bumpCtLocDepth,
  53. setCtLocOrigin, setCtLocEnv,
  54. CtOrigin(..),
  55. pushErrCtxt, pushErrCtxtSameOrigin,
  56. SkolemInfo(..),
  57. CtEvidence(..),
  58. mkGivenLoc,
  59. isWanted, isGiven,
  60. isDerived, canSolve, canRewrite,
  61. CtFlavour(..), ctEvFlavour, ctFlavour,
  62. -- Pretty printing
  63. pprEvVarTheta, pprWantedsWithLocs,
  64. pprEvVars, pprEvVarWithType,
  65. pprArising, pprArisingAt,
  66. -- Misc other types
  67. TcId, TcIdSet, TcTyVarBind(..), TcTyVarBinds
  68. ) where
  69. #include "HsVersions.h"
  70. import HsSyn
  71. import HscTypes
  72. import TcEvidence
  73. import Type
  74. import Class ( Class )
  75. import TyCon ( TyCon )
  76. import DataCon ( DataCon, dataConUserType )
  77. import TcType
  78. import Annotations
  79. import InstEnv
  80. import FamInstEnv
  81. import IOEnv
  82. import RdrName
  83. import Name
  84. import NameEnv
  85. import NameSet
  86. import Avail
  87. import Var
  88. import VarEnv
  89. import Module
  90. import SrcLoc
  91. import VarSet
  92. import ErrUtils
  93. import UniqFM
  94. import UniqSupply
  95. import BasicTypes
  96. import Bag
  97. import DynFlags
  98. import Outputable
  99. import ListSetOps
  100. import FastString
  101. import Data.Set (Set)
  102. \end{code}
  103. %************************************************************************
  104. %* *
  105. Standard monad definition for TcRn
  106. All the combinators for the monad can be found in TcRnMonad
  107. %* *
  108. %************************************************************************
  109. The monad itself has to be defined here, because it is mentioned by ErrCtxt
  110. \begin{code}
  111. type TcRef a = IORef a
  112. type TcId = Id
  113. type TcIdSet = IdSet
  114. type TcRnIf a b c = IOEnv (Env a b) c
  115. type IfM lcl a = TcRnIf IfGblEnv lcl a -- Iface stuff
  116. type IfG a = IfM () a -- Top level
  117. type IfL a = IfM IfLclEnv a -- Nested
  118. type TcRn a = TcRnIf TcGblEnv TcLclEnv a
  119. type RnM a = TcRn a -- Historical
  120. type TcM a = TcRn a -- Historical
  121. \end{code}
  122. Representation of type bindings to uninstantiated meta variables used during
  123. constraint solving.
  124. \begin{code}
  125. data TcTyVarBind = TcTyVarBind TcTyVar TcType
  126. type TcTyVarBinds = Bag TcTyVarBind
  127. instance Outputable TcTyVarBind where
  128. ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty
  129. \end{code}
  130. %************************************************************************
  131. %* *
  132. The main environment types
  133. %* *
  134. %************************************************************************
  135. \begin{code}
  136. -- We 'stack' these envs through the Reader like monad infastructure
  137. -- as we move into an expression (although the change is focused in
  138. -- the lcl type).
  139. data Env gbl lcl
  140. = Env {
  141. env_top :: HscEnv, -- Top-level stuff that never changes
  142. -- Includes all info about imported things
  143. env_us :: {-# UNPACK #-} !(IORef UniqSupply),
  144. -- Unique supply for local varibles
  145. env_gbl :: gbl, -- Info about things defined at the top level
  146. -- of the module being compiled
  147. env_lcl :: lcl -- Nested stuff; changes as we go into
  148. }
  149. instance ContainsDynFlags (Env gbl lcl) where
  150. extractDynFlags env = hsc_dflags (env_top env)
  151. -- TcGblEnv describes the top-level of the module at the
  152. -- point at which the typechecker is finished work.
  153. -- It is this structure that is handed on to the desugarer
  154. -- For state that needs to be updated during the typechecking
  155. -- phase and returned at end, use a TcRef (= IORef).
  156. data TcGblEnv
  157. = TcGblEnv {
  158. tcg_mod :: Module, -- ^ Module being compiled
  159. tcg_src :: HscSource,
  160. -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
  161. tcg_rdr_env :: GlobalRdrEnv, -- ^ Top level envt; used during renaming
  162. tcg_default :: Maybe [Type],
  163. -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
  164. tcg_fix_env :: FixityEnv, -- ^ Just for things in this module
  165. tcg_field_env :: RecFieldEnv, -- ^ Just for things in this module
  166. tcg_type_env :: TypeEnv,
  167. -- ^ Global type env for the module we are compiling now. All
  168. -- TyCons and Classes (for this module) end up in here right away,
  169. -- along with their derived constructors, selectors.
  170. --
  171. -- (Ids defined in this module start in the local envt, though they
  172. -- move to the global envt during zonking)
  173. tcg_type_env_var :: TcRef TypeEnv,
  174. -- Used only to initialise the interface-file
  175. -- typechecker in initIfaceTcRn, so that it can see stuff
  176. -- bound in this module when dealing with hi-boot recursions
  177. -- Updated at intervals (e.g. after dealing with types and classes)
  178. tcg_inst_env :: InstEnv,
  179. -- ^ Instance envt for all /home-package/ modules;
  180. -- Includes the dfuns in tcg_insts
  181. tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
  182. -- Now a bunch of things about this module that are simply
  183. -- accumulated, but never consulted until the end.
  184. -- Nevertheless, it's convenient to accumulate them along
  185. -- with the rest of the info from this module.
  186. tcg_exports :: [AvailInfo], -- ^ What is exported
  187. tcg_imports :: ImportAvails,
  188. -- ^ Information about what was imported from where, including
  189. -- things bound in this module. Also store Safe Haskell info
  190. -- here about transative trusted packaage requirements.
  191. tcg_dus :: DefUses,
  192. -- ^ What is defined in this module and what is used.
  193. -- The latter is used to generate
  194. --
  195. -- (a) version tracking; no need to recompile if these things have
  196. -- not changed version stamp
  197. --
  198. -- (b) unused-import info
  199. tcg_keep :: TcRef NameSet,
  200. -- ^ Locally-defined top-level names to keep alive.
  201. --
  202. -- "Keep alive" means give them an Exported flag, so that the
  203. -- simplifier does not discard them as dead code, and so that they
  204. -- are exposed in the interface file (but not to export to the
  205. -- user).
  206. --
  207. -- Some things, like dict-fun Ids and default-method Ids are "born"
  208. -- with the Exported flag on, for exactly the above reason, but some
  209. -- we only discover as we go. Specifically:
  210. --
  211. -- * The to/from functions for generic data types
  212. --
  213. -- * Top-level variables appearing free in the RHS of an orphan
  214. -- rule
  215. --
  216. -- * Top-level variables appearing free in a TH bracket
  217. tcg_th_used :: TcRef Bool,
  218. -- ^ @True@ <=> Template Haskell syntax used.
  219. --
  220. -- We need this so that we can generate a dependency on the
  221. -- Template Haskell package, becuase the desugarer is going
  222. -- to emit loads of references to TH symbols. The reference
  223. -- is implicit rather than explicit, so we have to zap a
  224. -- mutable variable.
  225. tcg_th_splice_used :: TcRef Bool,
  226. -- ^ @True@ <=> A Template Haskell splice was used.
  227. --
  228. -- Splices disable recompilation avoidance (see #481)
  229. tcg_dfun_n :: TcRef OccSet,
  230. -- ^ Allows us to choose unique DFun names.
  231. -- The next fields accumulate the payload of the module
  232. -- The binds, rules and foreign-decl fiels are collected
  233. -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
  234. tcg_rn_exports :: Maybe [Located (IE Name)],
  235. tcg_rn_imports :: [LImportDecl Name],
  236. -- Keep the renamed imports regardless. They are not
  237. -- voluminous and are needed if you want to report unused imports
  238. tcg_used_rdrnames :: TcRef (Set RdrName),
  239. -- The set of used *imported* (not locally-defined) RdrNames
  240. -- Used only to report unused import declarations
  241. tcg_rn_decls :: Maybe (HsGroup Name),
  242. -- ^ Renamed decls, maybe. @Nothing@ <=> Don't retain renamed
  243. -- decls.
  244. tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile
  245. tcg_ev_binds :: Bag EvBind, -- Top-level evidence bindings
  246. tcg_binds :: LHsBinds Id, -- Value bindings in this module
  247. tcg_sigs :: NameSet, -- ...Top-level names that *lack* a signature
  248. tcg_imp_specs :: [LTcSpecPrag], -- ...SPECIALISE prags for imported Ids
  249. tcg_warns :: Warnings, -- ...Warnings and deprecations
  250. tcg_anns :: [Annotation], -- ...Annotations
  251. tcg_tcs :: [TyCon], -- ...TyCons and Classes
  252. tcg_insts :: [ClsInst], -- ...Instances
  253. tcg_fam_insts :: [FamInst], -- ...Family instances
  254. tcg_rules :: [LRuleDecl Id], -- ...Rules
  255. tcg_fords :: [LForeignDecl Id], -- ...Foreign import & exports
  256. tcg_vects :: [LVectDecl Id], -- ...Vectorisation declarations
  257. tcg_doc_hdr :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
  258. tcg_hpc :: AnyHpcUsage, -- ^ @True@ if any part of the
  259. -- prog uses hpc instrumentation.
  260. tcg_main :: Maybe Name, -- ^ The Name of the main
  261. -- function, if this module is
  262. -- the main module.
  263. tcg_safeInfer :: TcRef Bool -- Has the typechecker
  264. -- inferred this module
  265. -- as -XSafe (Safe Haskell)
  266. }
  267. data RecFieldEnv
  268. = RecFields (NameEnv [Name]) -- Maps a constructor name *in this module*
  269. -- to the fields for that constructor
  270. NameSet -- Set of all fields declared *in this module*;
  271. -- used to suppress name-shadowing complaints
  272. -- when using record wild cards
  273. -- E.g. let fld = e in C {..}
  274. -- This is used when dealing with ".." notation in record
  275. -- construction and pattern matching.
  276. -- The FieldEnv deals *only* with constructors defined in *this*
  277. -- module. For imported modules, we get the same info from the
  278. -- TypeEnv
  279. \end{code}
  280. %************************************************************************
  281. %* *
  282. The interface environments
  283. Used when dealing with IfaceDecls
  284. %* *
  285. %************************************************************************
  286. \begin{code}
  287. data IfGblEnv
  288. = IfGblEnv {
  289. -- The type environment for the module being compiled,
  290. -- in case the interface refers back to it via a reference that
  291. -- was originally a hi-boot file.
  292. -- We need the module name so we can test when it's appropriate
  293. -- to look in this env.
  294. if_rec_types :: Maybe (Module, IfG TypeEnv)
  295. -- Allows a read effect, so it can be in a mutable
  296. -- variable; c.f. handling the external package type env
  297. -- Nothing => interactive stuff, no loops possible
  298. }
  299. data IfLclEnv
  300. = IfLclEnv {
  301. -- The module for the current IfaceDecl
  302. -- So if we see f = \x -> x
  303. -- it means M.f = \x -> x, where M is the if_mod
  304. if_mod :: Module,
  305. -- The field is used only for error reporting
  306. -- if (say) there's a Lint error in it
  307. if_loc :: SDoc,
  308. -- Where the interface came from:
  309. -- .hi file, or GHCi state, or ext core
  310. -- plus which bit is currently being examined
  311. if_tv_env :: UniqFM TyVar, -- Nested tyvar bindings
  312. -- (and coercions)
  313. if_id_env :: UniqFM Id -- Nested id binding
  314. }
  315. \end{code}
  316. %************************************************************************
  317. %* *
  318. The local typechecker environment
  319. %* *
  320. %************************************************************************
  321. The Global-Env/Local-Env story
  322. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  323. During type checking, we keep in the tcg_type_env
  324. * All types and classes
  325. * All Ids derived from types and classes (constructors, selectors)
  326. At the end of type checking, we zonk the local bindings,
  327. and as we do so we add to the tcg_type_env
  328. * Locally defined top-level Ids
  329. Why? Because they are now Ids not TcIds. This final GlobalEnv is
  330. a) fed back (via the knot) to typechecking the
  331. unfoldings of interface signatures
  332. b) used in the ModDetails of this module
  333. \begin{code}
  334. data TcLclEnv -- Changes as we move inside an expression
  335. -- Discarded after typecheck/rename; not passed on to desugarer
  336. = TcLclEnv {
  337. tcl_loc :: SrcSpan, -- Source span
  338. tcl_ctxt :: [ErrCtxt], -- Error context, innermost on top
  339. tcl_untch :: Untouchables, -- Birthplace for new unification variables
  340. tcl_th_ctxt :: ThStage, -- Template Haskell context
  341. tcl_arrow_ctxt :: ArrowCtxt, -- Arrow-notation context
  342. tcl_rdr :: LocalRdrEnv, -- Local name envt
  343. -- Maintained during renaming, of course, but also during
  344. -- type checking, solely so that when renaming a Template-Haskell
  345. -- splice we have the right environment for the renamer.
  346. --
  347. -- Does *not* include global name envt; may shadow it
  348. -- Includes both ordinary variables and type variables;
  349. -- they are kept distinct because tyvar have a different
  350. -- occurrence contructor (Name.TvOcc)
  351. -- We still need the unsullied global name env so that
  352. -- we can look up record field names
  353. tcl_env :: TcTypeEnv, -- The local type environment:
  354. -- Ids and TyVars defined in this module
  355. tcl_bndrs :: [TcIdBinder], -- Stack of locally-bound Ids, innermost on top
  356. -- Used only for error reporting
  357. tcl_tidy :: TidyEnv, -- Used for tidying types; contains all
  358. -- in-scope type variables (but not term variables)
  359. tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
  360. -- Namely, the in-scope TyVars bound in tcl_env,
  361. -- plus the tyvars mentioned in the types of Ids bound
  362. -- in tcl_lenv.
  363. -- Why mutable? see notes with tcGetGlobalTyVars
  364. tcl_lie :: TcRef WantedConstraints, -- Place to accumulate type constraints
  365. tcl_errs :: TcRef Messages -- Place to accumulate errors
  366. }
  367. type TcTypeEnv = NameEnv TcTyThing
  368. data TcIdBinder = TcIdBndr TcId TopLevelFlag
  369. {- Note [Given Insts]
  370. ~~~~~~~~~~~~~~~~~~
  371. Because of GADTs, we have to pass inwards the Insts provided by type signatures
  372. and existential contexts. Consider
  373. data T a where { T1 :: b -> b -> T [b] }
  374. f :: Eq a => T a -> Bool
  375. f (T1 x y) = [x]==[y]
  376. The constructor T1 binds an existential variable 'b', and we need Eq [b].
  377. Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we
  378. pass it inwards.
  379. -}
  380. ---------------------------
  381. -- Template Haskell stages and levels
  382. ---------------------------
  383. data ThStage -- See Note [Template Haskell state diagram] in TcSplice
  384. = Splice -- Top-level splicing
  385. -- This code will be run *at compile time*;
  386. -- the result replaces the splice
  387. -- Binding level = 0
  388. | Comp -- Ordinary Haskell code
  389. -- Binding level = 1
  390. | Brack -- Inside brackets
  391. ThStage -- Binding level = level(stage) + 1
  392. (TcRef [PendingSplice]) -- Accumulate pending splices here
  393. (TcRef WantedConstraints) -- and type constraints here
  394. topStage, topAnnStage, topSpliceStage :: ThStage
  395. topStage = Comp
  396. topAnnStage = Splice
  397. topSpliceStage = Splice
  398. instance Outputable ThStage where
  399. ppr Splice = text "Splice"
  400. ppr Comp = text "Comp"
  401. ppr (Brack s _ _) = text "Brack" <> parens (ppr s)
  402. type ThLevel = Int
  403. -- See Note [Template Haskell levels] in TcSplice
  404. -- Incremented when going inside a bracket,
  405. -- decremented when going inside a splice
  406. -- NB: ThLevel is one greater than the 'n' in Fig 2 of the
  407. -- original "Template meta-programming for Haskell" paper
  408. impLevel, outerLevel :: ThLevel
  409. impLevel = 0 -- Imported things; they can be used inside a top level splice
  410. outerLevel = 1 -- Things defined outside brackets
  411. -- NB: Things at level 0 are not *necessarily* imported.
  412. -- eg $( \b -> ... ) here b is bound at level 0
  413. --
  414. -- For example:
  415. -- f = ...
  416. -- g1 = $(map ...) is OK
  417. -- g2 = $(f ...) is not OK; because we havn't compiled f yet
  418. thLevel :: ThStage -> ThLevel
  419. thLevel Splice = 0
  420. thLevel Comp = 1
  421. thLevel (Brack s _ _) = thLevel s + 1
  422. ---------------------------
  423. -- Arrow-notation context
  424. ---------------------------
  425. {- Note [Escaping the arrow scope]
  426. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  427. In arrow notation, a variable bound by a proc (or enclosed let/kappa)
  428. is not in scope to the left of an arrow tail (-<) or the head of (|..|).
  429. For example
  430. proc x -> (e1 -< e2)
  431. Here, x is not in scope in e1, but it is in scope in e2. This can get
  432. a bit complicated:
  433. let x = 3 in
  434. proc y -> (proc z -> e1) -< e2
  435. Here, x and z are in scope in e1, but y is not.
  436. We implement this by
  437. recording the environment when passing a proc (using newArrowScope),
  438. and returning to that (using escapeArrowScope) on the left of -< and the
  439. head of (|..|).
  440. All this can be dealt with by the *renamer*; by the time we get to
  441. the *type checker* we have sorted out the scopes
  442. -}
  443. data ArrowCtxt
  444. = NoArrowCtxt
  445. | ArrowCtxt (Env TcGblEnv TcLclEnv)
  446. -- Record the current environment (outside a proc)
  447. newArrowScope :: TcM a -> TcM a
  448. newArrowScope
  449. = updEnv $ \env ->
  450. env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }
  451. -- Return to the stored environment (from the enclosing proc)
  452. escapeArrowScope :: TcM a -> TcM a
  453. escapeArrowScope
  454. = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
  455. NoArrowCtxt -> env
  456. ArrowCtxt env' -> env'
  457. ---------------------------
  458. -- TcTyThing
  459. ---------------------------
  460. data TcTyThing
  461. = AGlobal TyThing -- Used only in the return type of a lookup
  462. | ATcId { -- Ids defined in this module; may not be fully zonked
  463. tct_id :: TcId,
  464. tct_closed :: TopLevelFlag, -- See Note [Bindings with closed types]
  465. tct_level :: ThLevel }
  466. | ATyVar Name TcTyVar -- The type variable to which the lexically scoped type
  467. -- variable is bound. We only need the Name
  468. -- for error-message purposes; it is the corresponding
  469. -- Name in the domain of the envt
  470. | AThing TcKind -- Used temporarily, during kind checking, for the
  471. -- tycons and clases in this recursive group
  472. -- Can be a mono-kind or a poly-kind; in TcTyClsDcls see
  473. -- Note [Type checking recursive type and class declarations]
  474. | APromotionErr PromotionErr
  475. data PromotionErr
  476. = TyConPE -- TyCon used in a kind before we are ready
  477. -- data T :: T -> * where ...
  478. | ClassPE -- Ditto Class
  479. | FamDataConPE -- Data constructor for a data family
  480. -- See Note [AFamDataCon: not promoting data family constructors] in TcRnDriver
  481. | RecDataConPE -- Data constructor in a reuursive loop
  482. -- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls
  483. instance Outputable TcTyThing where -- Debugging only
  484. ppr (AGlobal g) = pprTyThing g
  485. ppr elt@(ATcId {}) = text "Identifier" <>
  486. brackets (ppr (tct_id elt) <> dcolon
  487. <> ppr (varType (tct_id elt)) <> comma
  488. <+> ppr (tct_closed elt) <> comma
  489. <+> ppr (tct_level elt))
  490. ppr (ATyVar n tv) = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv
  491. ppr (AThing k) = text "AThing" <+> ppr k
  492. ppr (APromotionErr err) = text "APromotionErr" <+> ppr err
  493. instance Outputable PromotionErr where
  494. ppr ClassPE = text "ClassPE"
  495. ppr TyConPE = text "TyConPE"
  496. ppr FamDataConPE = text "FamDataConPE"
  497. ppr RecDataConPE = text "RecDataConPE"
  498. pprTcTyThingCategory :: TcTyThing -> SDoc
  499. pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
  500. pprTcTyThingCategory (ATyVar {}) = ptext (sLit "Type variable")
  501. pprTcTyThingCategory (ATcId {}) = ptext (sLit "Local identifier")
  502. pprTcTyThingCategory (AThing {}) = ptext (sLit "Kinded thing")
  503. pprTcTyThingCategory (APromotionErr pe) = pprPECategory pe
  504. pprPECategory :: PromotionErr -> SDoc
  505. pprPECategory ClassPE = ptext (sLit "Class")
  506. pprPECategory TyConPE = ptext (sLit "Type constructor")
  507. pprPECategory FamDataConPE = ptext (sLit "Data constructor")
  508. pprPECategory RecDataConPE = ptext (sLit "Data constructor")
  509. \end{code}
  510. Note [Bindings with closed types]
  511. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  512. Consider
  513. f x = let g ys = map not ys
  514. in ...
  515. Can we generalise 'g' under the OutsideIn algorithm? Yes,
  516. because all g's free variables are top-level; that is they themselves
  517. have no free type variables, and it is the type variables in the
  518. environment that makes things tricky for OutsideIn generalisation.
  519. Definition:
  520. A variable is "closed", and has tct_closed set to TopLevel,
  521. iff
  522. a) all its free variables are imported, or are themselves closed
  523. b) generalisation is not restricted by the monomorphism restriction
  524. Under OutsideIn we are free to generalise a closed let-binding.
  525. This is an extension compared to the JFP paper on OutsideIn, which
  526. used "top-level" as a proxy for "closed". (It's not a good proxy
  527. anyway -- the MR can make a top-level binding with a free type
  528. variable.)
  529. Note that:
  530. * A top-level binding may not be closed, if it suffer from the MR
  531. * A nested binding may be closed (eg 'g' in the example we started with)
  532. Indeed, that's the point; whether a function is defined at top level
  533. or nested is orthogonal to the question of whether or not it is closed
  534. * A binding may be non-closed because it mentions a lexically scoped
  535. *type variable* Eg
  536. f :: forall a. blah
  537. f x = let g y = ...(y::a)...
  538. \begin{code}
  539. type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
  540. -- Monadic so that we have a chance
  541. -- to deal with bound type variables just before error
  542. -- message construction
  543. -- Bool: True <=> this is a landmark context; do not
  544. -- discard it when trimming for display
  545. \end{code}
  546. %************************************************************************
  547. %* *
  548. Operations over ImportAvails
  549. %* *
  550. %************************************************************************
  551. \begin{code}
  552. -- | 'ImportAvails' summarises what was imported from where, irrespective of
  553. -- whether the imported things are actually used or not. It is used:
  554. --
  555. -- * when processing the export list,
  556. --
  557. -- * when constructing usage info for the interface file,
  558. --
  559. -- * to identify the list of directly imported modules for initialisation
  560. -- purposes and for optimised overlap checking of family instances,
  561. --
  562. -- * when figuring out what things are really unused
  563. --
  564. data ImportAvails
  565. = ImportAvails {
  566. imp_mods :: ImportedMods,
  567. -- = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)],
  568. -- ^ Domain is all directly-imported modules
  569. -- The 'ModuleName' is what the module was imported as, e.g. in
  570. -- @
  571. -- import Foo as Bar
  572. -- @
  573. -- it is @Bar@.
  574. --
  575. -- The 'Bool' means:
  576. --
  577. -- - @True@ => import was @import Foo ()@
  578. --
  579. -- - @False@ => import was some other form
  580. --
  581. -- Used
  582. --
  583. -- (a) to help construct the usage information in the interface
  584. -- file; if we import somethign we need to recompile if the
  585. -- export version changes
  586. --
  587. -- (b) to specify what child modules to initialise
  588. --
  589. -- We need a full ModuleEnv rather than a ModuleNameEnv here,
  590. -- because we might be importing modules of the same name from
  591. -- different packages. (currently not the case, but might be in the
  592. -- future).
  593. imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
  594. -- ^ Home-package modules needed by the module being compiled
  595. --
  596. -- It doesn't matter whether any of these dependencies
  597. -- are actually /used/ when compiling the module; they
  598. -- are listed if they are below it at all. For
  599. -- example, suppose M imports A which imports X. Then
  600. -- compiling M might not need to consult X.hi, but X
  601. -- is still listed in M's dependencies.
  602. imp_dep_pkgs :: [PackageId],
  603. -- ^ Packages needed by the module being compiled, whether directly,
  604. -- or via other modules in this package, or via modules imported
  605. -- from other packages.
  606. imp_trust_pkgs :: [PackageId],
  607. -- ^ This is strictly a subset of imp_dep_pkgs and records the
  608. -- packages the current module needs to trust for Safe Haskell
  609. -- compilation to succeed. A package is required to be trusted if
  610. -- we are dependent on a trustworthy module in that package.
  611. -- While perhaps making imp_dep_pkgs a tuple of (PackageId, Bool)
  612. -- where True for the bool indicates the package is required to be
  613. -- trusted is the more logical design, doing so complicates a lot
  614. -- of code not concerned with Safe Haskell.
  615. -- See Note [RnNames . Tracking Trust Transitively]
  616. imp_trust_own_pkg :: Bool,
  617. -- ^ Do we require that our own package is trusted?
  618. -- This is to handle efficiently the case where a Safe module imports
  619. -- a Trustworthy module that resides in the same package as it.
  620. -- See Note [RnNames . Trust Own Package]
  621. imp_orphs :: [Module],
  622. -- ^ Orphan modules below us in the import tree (and maybe including
  623. -- us for imported modules)
  624. imp_finsts :: [Module]
  625. -- ^ Family instance modules below us in the import tree (and maybe
  626. -- including us for imported modules)
  627. }
  628. mkModDeps :: [(ModuleName, IsBootInterface)]
  629. -> ModuleNameEnv (ModuleName, IsBootInterface)
  630. mkModDeps deps = foldl add emptyUFM deps
  631. where
  632. add env elt@(m,_) = addToUFM env m elt
  633. emptyImportAvails :: ImportAvails
  634. emptyImportAvails = ImportAvails { imp_mods = emptyModuleEnv,
  635. imp_dep_mods = emptyUFM,
  636. imp_dep_pkgs = [],
  637. imp_trust_pkgs = [],
  638. imp_trust_own_pkg = False,
  639. imp_orphs = [],
  640. imp_finsts = [] }
  641. -- | Union two ImportAvails
  642. --
  643. -- This function is a key part of Import handling, basically
  644. -- for each import we create a seperate ImportAvails structure
  645. -- and then union them all together with this function.
  646. plusImportAvails :: ImportAvails -> ImportAvails -> ImportAvails
  647. plusImportAvails
  648. (ImportAvails { imp_mods = mods1,
  649. imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
  650. imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,
  651. imp_orphs = orphs1, imp_finsts = finsts1 })
  652. (ImportAvails { imp_mods = mods2,
  653. imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
  654. imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
  655. imp_orphs = orphs2, imp_finsts = finsts2 })
  656. = ImportAvails { imp_mods = plusModuleEnv_C (++) mods1 mods2,
  657. imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
  658. imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
  659. imp_trust_pkgs = tpkgs1 `unionLists` tpkgs2,
  660. imp_trust_own_pkg = tself1 || tself2,
  661. imp_orphs = orphs1 `unionLists` orphs2,
  662. imp_finsts = finsts1 `unionLists` finsts2 }
  663. where
  664. plus_mod_dep (m1, boot1) (m2, boot2)
  665. = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
  666. -- Check mod-names match
  667. (m1, boot1 && boot2) -- If either side can "see" a non-hi-boot interface, use that
  668. \end{code}
  669. %************************************************************************
  670. %* *
  671. \subsection{Where from}
  672. %* *
  673. %************************************************************************
  674. The @WhereFrom@ type controls where the renamer looks for an interface file
  675. \begin{code}
  676. data WhereFrom
  677. = ImportByUser IsBootInterface -- Ordinary user import (perhaps {-# SOURCE #-})
  678. | ImportBySystem -- Non user import.
  679. instance Outputable WhereFrom where
  680. ppr (ImportByUser is_boot) | is_boot = ptext (sLit "{- SOURCE -}")
  681. | otherwise = empty
  682. ppr ImportBySystem = ptext (sLit "{- SYSTEM -}")
  683. \end{code}
  684. %************************************************************************
  685. %* *
  686. %* Canonical constraints *
  687. %* *
  688. %* These are the constraints the low-level simplifier works with *
  689. %* *
  690. %************************************************************************
  691. \begin{code}
  692. -- The syntax of xi types:
  693. -- xi ::= a | T xis | xis -> xis | ... | forall a. tau
  694. -- Two important notes:
  695. -- (i) No type families, unless we are under a ForAll
  696. -- (ii) Note that xi types can contain unexpanded type synonyms;
  697. -- however, the (transitive) expansions of those type synonyms
  698. -- will not contain any type functions, unless we are under a ForAll.
  699. -- We enforce the structure of Xi types when we flatten (TcCanonical)
  700. type Xi = Type -- In many comments, "xi" ranges over Xi
  701. type Cts = Bag Ct
  702. data Ct
  703. -- Atomic canonical constraints
  704. = CDictCan { -- e.g. Num xi
  705. cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant]
  706. cc_class :: Class,
  707. cc_tyargs :: [Xi],
  708. cc_loc :: CtLoc
  709. }
  710. | CIrredEvCan { -- These stand for yet-unknown predicates
  711. cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant]
  712. -- In CIrredEvCan, the ctev_pred of the evidence is flat
  713. -- and hence it may only be of the form (tv xi1 xi2 ... xin)
  714. -- Since, if it were a type constructor application, that'd make the
  715. -- whole constraint a CDictCan, or CTyEqCan. And it can't be
  716. -- a type family application either because it's a Xi type.
  717. cc_loc :: CtLoc
  718. }
  719. | CTyEqCan { -- tv ~ xi (recall xi means function free)
  720. -- Invariant:
  721. -- * tv not in tvs(xi) (occurs check)
  722. -- * typeKind xi `compatKind` typeKind tv
  723. -- See Note [Spontaneous solving and kind compatibility]
  724. -- * We prefer unification variables on the left *JUST* for efficiency
  725. cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant]
  726. cc_tyvar :: TcTyVar,
  727. cc_rhs :: Xi,
  728. cc_loc :: CtLoc
  729. }
  730. | CFunEqCan { -- F xis ~ xi
  731. -- Invariant: * isSynFamilyTyCon cc_fun
  732. -- * typeKind (F xis) `compatKind` typeKind xi
  733. cc_ev :: CtEvidence, -- See Note [Ct/evidence invariant]
  734. cc_fun :: TyCon, -- A type function
  735. cc_tyargs :: [Xi], -- Either under-saturated or exactly saturated
  736. cc_rhs :: Xi, -- *never* over-saturated (because if so
  737. -- we should have decomposed)
  738. cc_loc :: CtLoc
  739. }
  740. | CNonCanonical { -- See Note [NonCanonical Semantics]
  741. cc_ev :: CtEvidence,
  742. cc_loc :: CtLoc
  743. }
  744. | CHoleCan {
  745. cc_ev :: CtEvidence,
  746. cc_loc :: CtLoc
  747. }
  748. \end{code}
  749. Note [Ct/evidence invariant]
  750. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  751. If ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field
  752. of (cc_ev ct). Eg for CDictCan,
  753. ctev_pred (cc_ev ct) = (cc_class ct) (cc_tyargs ct)
  754. This holds by construction; look at the unique place where CDictCan is
  755. built (in TcCanonical)
  756. \begin{code}
  757. mkNonCanonical :: CtLoc -> CtEvidence -> Ct
  758. mkNonCanonical loc ev = CNonCanonical { cc_ev = ev, cc_loc = loc }
  759. mkNonCanonicalCt :: Ct -> Ct
  760. mkNonCanonicalCt ct = CNonCanonical { cc_ev = cc_ev ct, cc_loc = cc_loc ct }
  761. ctEvidence :: Ct -> CtEvidence
  762. ctEvidence = cc_ev
  763. ctPred :: Ct -> PredType
  764. -- See Note [Ct/evidence invariant]
  765. ctPred ct = ctEvPred (cc_ev ct)
  766. dropDerivedWC :: WantedConstraints -> WantedConstraints
  767. dropDerivedWC wc@(WC { wc_flat = flats })
  768. = wc { wc_flat = filterBag isWantedCt flats }
  769. -- Don't filter the insolubles, because derived
  770. -- insolubles should stay so that we report them.
  771. -- The implications are (recursively) already filtered
  772. \end{code}
  773. %************************************************************************
  774. %* *
  775. CtEvidence
  776. The "flavor" of a canonical constraint
  777. %* *
  778. %************************************************************************
  779. \begin{code}
  780. isWantedCt :: Ct -> Bool
  781. isWantedCt = isWanted . cc_ev
  782. isGivenCt :: Ct -> Bool
  783. isGivenCt = isGiven . cc_ev
  784. isDerivedCt :: Ct -> Bool
  785. isDerivedCt = isDerived . cc_ev
  786. isCTyEqCan :: Ct -> Bool
  787. isCTyEqCan (CTyEqCan {}) = True
  788. isCTyEqCan (CFunEqCan {}) = False
  789. isCTyEqCan _ = False
  790. isCDictCan_Maybe :: Ct -> Maybe Class
  791. isCDictCan_Maybe (CDictCan {cc_class = cls }) = Just cls
  792. isCDictCan_Maybe _ = Nothing
  793. isCIrredEvCan :: Ct -> Bool
  794. isCIrredEvCan (CIrredEvCan {}) = True
  795. isCIrredEvCan _ = False
  796. isCFunEqCan_Maybe :: Ct -> Maybe TyCon
  797. isCFunEqCan_Maybe (CFunEqCan { cc_fun = tc }) = Just tc
  798. isCFunEqCan_Maybe _ = Nothing
  799. isCFunEqCan :: Ct -> Bool
  800. isCFunEqCan (CFunEqCan {}) = True
  801. isCFunEqCan _ = False
  802. isCNonCanonical :: Ct -> Bool
  803. isCNonCanonical (CNonCanonical {}) = True
  804. isCNonCanonical _ = False
  805. isHoleCt:: Ct -> Bool
  806. isHoleCt (CHoleCan {}) = True
  807. isHoleCt _ = False
  808. \end{code}
  809. \begin{code}
  810. instance Outputable Ct where
  811. ppr ct = ppr (cc_ev ct) <+> parens (text ct_sort)
  812. where ct_sort = case ct of
  813. CTyEqCan {} -> "CTyEqCan"
  814. CFunEqCan {} -> "CFunEqCan"
  815. CNonCanonical {} -> "CNonCanonical"
  816. CDictCan {} -> "CDictCan"
  817. CIrredEvCan {} -> "CIrredEvCan"
  818. CHoleCan {} -> "CHoleCan"
  819. \end{code}
  820. \begin{code}
  821. singleCt :: Ct -> Cts
  822. singleCt = unitBag
  823. andCts :: Cts -> Cts -> Cts
  824. andCts = unionBags
  825. extendCts :: Cts -> Ct -> Cts
  826. extendCts = snocBag
  827. andManyCts :: [Cts] -> Cts
  828. andManyCts = unionManyBags
  829. emptyCts :: Cts
  830. emptyCts = emptyBag
  831. isEmptyCts :: Cts -> Bool
  832. isEmptyCts = isEmptyBag
  833. \end{code}
  834. %************************************************************************
  835. %* *
  836. Wanted constraints
  837. These are forced to be in TcRnTypes because
  838. TcLclEnv mentions WantedConstraints
  839. WantedConstraint mentions CtLoc
  840. CtLoc mentions ErrCtxt
  841. ErrCtxt mentions TcM
  842. %* *
  843. v%************************************************************************
  844. \begin{code}
  845. data WantedConstraints
  846. = WC { wc_flat :: Cts -- Unsolved constraints, all wanted
  847. , wc_impl :: Bag Implication
  848. , wc_insol :: Cts -- Insoluble constraints, can be
  849. -- wanted, given, or derived
  850. -- See Note [Insoluble constraints]
  851. }
  852. emptyWC :: WantedConstraints
  853. emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
  854. mkFlatWC :: [Ct] -> WantedConstraints
  855. mkFlatWC cts
  856. = WC { wc_flat = listToBag cts, wc_impl = emptyBag, wc_insol = emptyBag }
  857. isEmptyWC :: WantedConstraints -> Bool
  858. isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
  859. = isEmptyBag f && isEmptyBag i && isEmptyBag n
  860. insolubleWC :: WantedConstraints -> Bool
  861. -- True if there are any insoluble constraints in the wanted bag
  862. insolubleWC wc = not (isEmptyBag (wc_insol wc))
  863. || anyBag ic_insol (wc_impl wc)
  864. andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
  865. andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
  866. (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
  867. = WC { wc_flat = f1 `unionBags` f2
  868. , wc_impl = i1 `unionBags` i2
  869. , wc_insol = n1 `unionBags` n2 }
  870. unionsWC :: [WantedConstraints] -> WantedConstraints
  871. unionsWC = foldr andWC emptyWC
  872. addFlats :: WantedConstraints -> Bag Ct -> WantedConstraints
  873. addFlats wc cts
  874. = wc { wc_flat = wc_flat wc `unionBags` cts }
  875. addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
  876. addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
  877. addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints
  878. addInsols wc cts
  879. = wc { wc_insol = wc_insol wc `unionBags` cts }
  880. instance Outputable WantedConstraints where
  881. ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
  882. = ptext (sLit "WC") <+> braces (vcat
  883. [ if isEmptyBag f then empty else
  884. ptext (sLit "wc_flat =") <+> pprBag ppr f
  885. , if isEmptyBag i then empty else
  886. ptext (sLit "wc_impl =") <+> pprBag ppr i
  887. , if isEmptyBag n then empty else
  888. ptext (sLit "wc_insol =") <+> pprBag ppr n ])
  889. pprBag :: (a -> SDoc) -> Bag a -> SDoc
  890. pprBag pp b = foldrBag (($$) . pp) empty b
  891. \end{code}
  892. %************************************************************************
  893. %* *
  894. Implication constraints
  895. %* *
  896. %************************************************************************
  897. \begin{code}
  898. data Implication
  899. = Implic {
  900. ic_untch :: Untouchables, -- Untouchables: unification variables
  901. -- free in the environment
  902. ic_skols :: [TcTyVar], -- Introduced skolems
  903. ic_info :: SkolemInfo, -- See Note [Skolems in an implication]
  904. -- See Note [Shadowing in a constraint]
  905. ic_fsks :: [TcTyVar], -- Extra flatten-skolems introduced by the flattening
  906. -- done by canonicalisation.
  907. ic_given :: [EvVar], -- Given evidence variables
  908. -- (order does not matter)
  909. ic_env :: TcLclEnv, -- Gives the source location and error context
  910. -- for the implicatdion, and hence for all the
  911. -- given evidence variables
  912. ic_wanted :: WantedConstraints, -- The wanted
  913. ic_insol :: Bool, -- True iff insolubleWC ic_wanted is true
  914. ic_binds :: EvBindsVar -- Points to the place to fill in the
  915. -- abstraction and bindings
  916. }
  917. instance Outputable Implication where
  918. ppr (Implic { ic_untch = untch, ic_skols = skols, ic_fsks = fsks
  919. , ic_given = given
  920. , ic_wanted = wanted
  921. , ic_binds = binds, ic_info = info })
  922. = ptext (sLit "Implic") <+> braces
  923. (sep [ ptext (sLit "Untouchables =") <+> ppr untch
  924. , ptext (sLit "Skolems =") <+> ppr skols
  925. , ptext (sLit "Flatten-skolems =") <+> ppr fsks
  926. , ptext (sLit "Given =") <+> pprEvVars given
  927. , ptext (sLit "Wanted =") <+> ppr wanted
  928. , ptext (sLit "Binds =") <+> ppr binds
  929. , pprSkolInfo info ])
  930. \end{code}
  931. Note [Shadowing in a constraint]
  932. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  933. We assume NO SHADOWING in a constraint. Specifically
  934. * The unification variables are all implicitly quantified at top
  935. level, and are all unique
  936. * The skolem varibles bound in ic_skols are all freah when the
  937. implication is created.
  938. So we can safely substitute. For example, if we have
  939. forall a. a~Int => ...(forall b. ...a...)...
  940. we can push the (a~Int) constraint inwards in the "givens" without
  941. worrying that 'b' might clash.
  942. Note [Skolems in an implication]
  943. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  944. The skolems in an implication are not there to perform a skolem escape
  945. check. That happens because all the environment variables are in the
  946. untouchables, and therefore cannot be unified with anything at all,
  947. let alone the skolems.
  948. Instead, ic_skols is used only when considering floating a constraint
  949. outside the implication in TcSimplify.floatEqualities or
  950. TcSimplify.approximateImplications
  951. Note [Insoluble constraints]
  952. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  953. Some of the errors that we get during canonicalization are best
  954. reported when all constraints have been simplified as much as
  955. possible. For instance, assume that during simplification the
  956. following constraints arise:
  957. [Wanted] F alpha ~ uf1
  958. [Wanted] beta ~ uf1 beta
  959. When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
  960. we will simply see a message:
  961. 'Can't construct the infinite type beta ~ uf1 beta'
  962. and the user has no idea what the uf1 variable is.
  963. Instead our plan is that we will NOT fail immediately, but:
  964. (1) Record the "frozen" error in the ic_insols field
  965. (2) Isolate the offending constraint from the rest of the inerts
  966. (3) Keep on simplifying/canonicalizing
  967. At the end, we will hopefully have substituted uf1 := F alpha, and we
  968. will be able to report a more informative error:
  969. 'Can't construct the infinite type beta ~ F alpha beta'
  970. Insoluble constraints *do* include Derived constraints. For example,
  971. a functional dependency might give rise to [D] Int ~ Bool, and we must
  972. report that. If insolubles did not contain Deriveds, reportErrors would
  973. never see it.
  974. %************************************************************************
  975. %* *
  976. Pretty printing
  977. %* *
  978. %************************************************************************
  979. \begin{code}
  980. pprEvVars :: [EvVar] -> SDoc -- Print with their types
  981. pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)
  982. pprEvVarTheta :: [EvVar] -> SDoc
  983. pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
  984. pprEvVarWithType :: EvVar -> SDoc
  985. pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)
  986. pprWantedsWithLocs :: WantedConstraints -> SDoc
  987. pprWantedsWithLocs wcs
  988. = vcat [ pprBag ppr (wc_flat wcs)
  989. , pprBag ppr (wc_impl wcs)
  990. , pprBag ppr (wc_insol wcs) ]
  991. \end{code}
  992. %************************************************************************
  993. %* *
  994. CtEvidence
  995. %* *
  996. %************************************************************************
  997. Note [Evidence field of CtEvidence]
  998. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  999. During constraint solving we never look at the type of ctev_evtm, or
  1000. ctev_evar; instead we look at the cte_pred field. The evtm/evar field
  1001. may be un-zonked.
  1002. \begin{code}
  1003. data CtEvidence
  1004. = CtGiven { ctev_pred :: TcPredType
  1005. , ctev_evtm :: EvTerm } -- See Note [Evidence field of CtEvidence]
  1006. -- Truly given, not depending on subgoals
  1007. -- NB: Spontaneous unifications belong here
  1008. | CtWanted { ctev_pred :: TcPredType
  1009. , ctev_evar :: EvVar } -- See Note [Evidence field of CtEvidence]
  1010. -- Wanted goal
  1011. | CtDerived { ctev_pred :: TcPredType }
  1012. -- A goal that we don't really have to solve and can't immediately
  1013. -- rewrite anything other than a derived (there's no evidence!)
  1014. -- but if we do manage to solve it may help in solving other goals.
  1015. data CtFlavour = Given | Wanted | Derived
  1016. ctFlavour :: Ct -> CtFlavour
  1017. ctFlavour ct = ctEvFlavour (cc_ev ct)
  1018. ctEvFlavour :: CtEvidence -> CtFlavour
  1019. ctEvFlavour (CtGiven {}) = Given
  1020. ctEvFlavour (CtWanted {}) = Wanted
  1021. ctEvFlavour (CtDerived {}) = Derived
  1022. ctEvPred :: CtEvidence -> TcPredType
  1023. -- The predicate of a flavor
  1024. ctEvPred = ctev_pred
  1025. ctEvTerm :: CtEvidence -> EvTerm
  1026. ctEvTerm (CtGiven { ctev_evtm = tm }) = tm
  1027. ctEvTerm (CtWanted { ctev_evar = ev }) = EvId ev
  1028. ctEvTerm ctev@(CtDerived {}) = pprPanic "ctEvTerm: derived constraint cannot have id"
  1029. (ppr ctev)
  1030. ctEvId :: CtEvidence -> TcId
  1031. ctEvId (CtWanted { ctev_evar = ev }) = ev
  1032. ctEvId ctev = pprPanic "ctEvId:" (ppr ctev)
  1033. instance Outputable CtFlavour where
  1034. ppr Given = ptext (sLit "[G]")
  1035. ppr Wanted = ptext (sLit "[W]")
  1036. ppr Derived = ptext (sLit "[D]")
  1037. instance Outputable CtEvidence where
  1038. ppr fl = case fl of
  1039. CtGiven {} -> ptext (sLit "[G]") <+> ppr (ctev_evtm fl) <+> ppr_pty
  1040. CtWanted {} -> ptext (sLit "[W]") <+> ppr (ctev_evar fl) <+> ppr_pty
  1041. CtDerived {} -> ptext (sLit "[D]") <+> text "_" <+> ppr_pty
  1042. where ppr_pty = dcolon <+> ppr (ctEvPred fl)
  1043. isWanted :: CtEvidence -> Bool
  1044. isWanted (CtWanted {}) = True
  1045. isWanted _ = False
  1046. isGiven :: CtEvidence -> Bool
  1047. isGiven (CtGiven {}) = True
  1048. isGiven _ = False
  1049. isDerived :: CtEvidence -> Bool
  1050. isDerived (CtDerived {}) = True
  1051. isDerived _ = False
  1052. canSolve :: CtFlavour -> CtFlavour -> Bool
  1053. -- canSolve ctid1 ctid2
  1054. -- The constraint ctid1 can be used to solve ctid2
  1055. -- "to solve" means a reaction where the active parts of the two constraints match.
  1056. -- active(F xis ~ xi) = F xis
  1057. -- active(tv ~ xi) = tv
  1058. -- active(D xis) = D xis
  1059. -- active(IP nm ty) = nm
  1060. --
  1061. -- NB: either (a `canSolve` b) or (b `canSolve` a) must hold
  1062. -----------------------------------------
  1063. canSolve Given _ = True
  1064. canSolve Wanted Derived = True
  1065. canSolve Wanted Wanted = True
  1066. canSolve Derived Derived = True -- Derived can't solve wanted/given
  1067. canSolve _ _ = False -- No evidence for a derived, anyway
  1068. canRewrite :: CtFlavour -> CtFlavour -> Bool
  1069. -- canRewrite ct1 ct2
  1070. -- The equality constraint ct1 can be used to rewrite inside ct2
  1071. canRewrite = canSolve
  1072. \end{code}
  1073. %************************************************************************
  1074. %* *
  1075. CtLoc
  1076. %* *
  1077. %************************************************************************
  1078. The 'CtLoc' gives information about where a constraint came from.
  1079. This is important for decent error message reporting because
  1080. dictionaries don't appear in the original source code.
  1081. type will evolve...
  1082. \begin{code}
  1083. data CtLoc = CtLoc { ctl_origin :: CtOrigin
  1084. , ctl_env :: TcLclEnv
  1085. , ctl_depth :: SubGoalDepth }
  1086. -- The TcLclEnv includes particularly
  1087. -- source location: tcl_loc :: SrcSpan
  1088. -- context: tcl_ctxt :: [ErrCtxt]
  1089. -- binder stack: tcl_bndrs :: [TcIdBinders]
  1090. type SubGoalDepth = Int -- An ever increasing number used to restrict
  1091. -- simplifier iterations. Bounded by -fcontext-stack.
  1092. -- See Note [WorkList]
  1093. mkGivenLoc :: SkolemInfo -> TcLclEnv -> CtLoc
  1094. mkGivenLoc skol_info env = CtLoc { ctl_origin = GivenOrigin skol_info
  1095. , ctl_env = env
  1096. , ctl_depth = 0 }
  1097. ctLocEnv :: CtLoc -> TcLclEnv
  1098. ctLocEnv = ctl_env
  1099. ctLocDepth :: CtLoc -> SubGoalDepth
  1100. ctLocDepth = ctl_depth
  1101. ctLocOrigin :: CtLoc -> CtOrigin
  1102. ctLocOrigin = ctl_origin
  1103. ctLocSpan :: CtLoc -> SrcSpan
  1104. ctLocSpan (CtLoc { ctl_env = lcl}) = tcl_loc lcl
  1105. bumpCtLocDepth :: CtLoc -> CtLoc
  1106. bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = d+1 }
  1107. setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
  1108. setCtLocOrigin ctl orig = ctl { ctl_origin = orig }
  1109. setCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc
  1110. setCtLocEnv ctl env = ctl { ctl_env = env }
  1111. pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc
  1112. pushErrCtxt o err loc@(CtLoc { ctl_env = lcl })
  1113. = loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }
  1114. pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc
  1115. -- Just add information w/o updating the origin!
  1116. pushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })
  1117. = loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }
  1118. pprArising :: CtOrigin -> SDoc
  1119. -- Used for the main, top-l

Large files files are truncated, but you can click here to view the full file