PageRenderTime 50ms CodeModel.GetById 10ms RepoModel.GetById 0ms app.codeStats 1ms

/compiler/typecheck/TcRnTypes.lhs

https://bitbucket.org/khibino/ghc-hack
Haskell | 1475 lines | 846 code | 263 blank | 366 comment | 19 complexity | 85e767104f526b642f9fa22c4df4faa0 MD5 | raw file
Possible License(s): BSD-3-Clause, BSD-2-Clause, LGPL-3.0

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

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