tcg_warns :: Warnings, -- ...Warnings and deprecations
tcg_anns :: [Annotation], -- ...Annotations
tcg_insts :: [Instance], -- ...Instances
- tcg_fam_insts :: [FamInst], -- ...Family instances
- tcg_rules :: [LRuleDecl Id], -- ...Rules
- tcg_fords :: [LForeignDecl Id], -- ...Foreign import & exports
+ tcg_fam_insts :: [FamInst], -- ...Family instances
+ tcg_rules :: [LRuleDecl Id], -- ...Rules
+ tcg_fords :: [LForeignDecl Id], -- ...Foreign import & exports
+ tcg_vects :: [LVectDecl Id], -- ...Vectorisation declarations
tcg_doc_hdr :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
tcg_hpc :: AnyHpcUsage, -- ^ @True@ if any part of the
-- We still need the unsullied global name env so that
-- we can look up record field names
+ tcl_hetMetLevel :: [TyVar], -- The current environment classifier level (list-of-names)
tcl_env :: TcTypeEnv, -- The local type environment: Ids and
-- TyVars defined in this module
| ATcId { -- Ids defined in this module; may not be fully zonked
tct_id :: TcId,
- tct_level :: ThLevel }
+ tct_level :: ThLevel,
+ tct_hetMetLevel :: [TyVar]
+ }
| ATyVar Name TcType -- The type to which the lexically scoped type vaiable
-- is currently refined. We only need the Name
ppr elt@(ATcId {}) = text "Identifier" <>
brackets (ppr (tct_id elt) <> dcolon
<> ppr (varType (tct_id elt)) <> comma
- <+> ppr (tct_level elt))
+ <+> ppr (tct_level elt)
+ <+> ppr (tct_hetMetLevel elt))
ppr (ATyVar tv _) = text "Type variable" <+> quotes (ppr tv)
ppr (AThing k) = text "AThing" <+> ppr k
, wc_insol = n1 `unionBags` n2 }
addFlats :: WantedConstraints -> Bag WantedEvVar -> WantedConstraints
-addFlats wc wevs = wc { wc_flat = wevs `unionBags` wc_flat wc }
+addFlats wc wevs = wc { wc_flat = wc_flat wc `unionBags` wevs }
addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
-addImplics wc implic = wc { wc_impl = implic `unionBags` wc_impl wc }
+addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
instance Outputable WantedConstraints where
ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
-- which is also the location of all the
-- given evidence variables
- ic_wanted :: WantedConstraints, -- The wanted
- ic_insol :: Bool, -- True iff insolubleWC ic_wantted is true
+ ic_wanted :: WantedConstraints, -- The wanted
+ ic_insol :: Bool, -- True iff insolubleWC ic_wanted is true
ic_binds :: EvBindsVar -- Points to the place to fill in the
-- abstraction and bindings
keepWanted :: Bag FlavoredEvVar -> Bag WantedEvVar
keepWanted flevs
- = foldlBag keep_wanted emptyBag flevs
+ = foldrBag keep_wanted emptyBag flevs
+ -- Important: use fold*r*Bag to preserve the order of the evidence variables.
where
- keep_wanted :: Bag WantedEvVar -> FlavoredEvVar -> Bag WantedEvVar
- keep_wanted r (EvVarX ev (Wanted wloc)) = consBag (EvVarX ev wloc) r
- keep_wanted r _ = r
+ keep_wanted :: FlavoredEvVar -> Bag WantedEvVar -> Bag WantedEvVar
+ keep_wanted (EvVarX ev (Wanted wloc)) r = consBag (EvVarX ev wloc) r
+ keep_wanted _ r = r
\end{code}
-- superclasses.
instance Outputable CtFlavor where
- ppr (Given _) = ptext (sLit "[Given]")
- ppr (Wanted _) = ptext (sLit "[Wanted]")
- ppr (Derived {}) = ptext (sLit "[Derived]")
-
+ ppr (Given {}) = ptext (sLit "[G]")
+ ppr (Wanted {}) = ptext (sLit "[W]")
+ ppr (Derived {}) = ptext (sLit "[D]")
pprFlavorArising :: CtFlavor -> SDoc
pprFlavorArising (Derived wl ) = pprArisingAt wl
pprFlavorArising (Wanted wl) = pprArisingAt wl