2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[Inst]{The @Inst@ type: dictionaries or method instances}
8 LIE, emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE,
9 plusLIEs, mkLIE, isEmptyLIE,
11 Inst, OverloadedLit(..),
12 pprInst, pprInsts, pprInstsInFull, tidyInst, tidyInsts,
16 newDictFromOld, newDicts, newDictsAtLoc,
17 newMethod, newMethodWithGivenTy, newOverloadedLit,
19 tyVarsOfInst, instLoc, getDictClassTys,
21 lookupInst, lookupSimpleInst, LookupInstResult(..),
23 isDict, isTyVarDict, isStdClassTyVarDict, isMethodFor,
24 instBindingRequired, instCanBeGeneralised,
26 zonkInst, instToId, instToIdBndr,
28 InstOrigin(..), pprOrigin
31 #include "HsVersions.h"
33 import HsSyn ( HsLit(..), HsExpr(..) )
34 import RnHsSyn ( RenamedArithSeqInfo, RenamedHsExpr, RenamedPat )
35 import TcHsSyn ( TcExpr, TcIdOcc(..), TcIdBndr,
36 mkHsTyApp, mkHsDictApp, tcIdTyVars, zonkTcId
39 import TcEnv ( TcIdSet, tcLookupGlobalValueByKey, tcLookupTyConByKey,
42 import TcType ( TcThetaType,
43 TcType, TcTauType, TcTyVarSet,
44 zonkTcType, zonkTcTypes,
48 import Class ( classInstEnv,
51 import Id ( Id, idType, mkUserLocal, mkSysLocal )
52 import VarSet ( elemVarSet )
53 import PrelInfo ( isStandardClass, isCcallishClass, isNoDictClass )
54 import Name ( OccName(..), Name, occNameString, getOccName )
55 import PprType ( pprConstraint )
56 import SpecEnv ( SpecEnv, lookupSpecEnv )
57 import SrcLoc ( SrcLoc )
58 import Type ( Type, ThetaType, substTy,
59 isTyVarTy, mkDictTy, splitForAllTys, splitSigmaTy,
60 splitRhoTy, tyVarsOfType, tyVarsOfTypes,
61 mkSynTy, substFlexiTy, substFlexiTheta
63 import TyCon ( TyCon )
64 import VarEnv ( zipVarEnv, lookupVarEnv )
65 import VarSet ( unionVarSet )
66 import TysPrim ( intPrimTy, floatPrimTy, doublePrimTy )
67 import TysWiredIn ( intDataCon, isIntTy, inIntRange,
68 floatDataCon, isFloatTy,
69 doubleDataCon, isDoubleTy,
70 integerTy, isIntegerTy
72 import Unique ( fromRationalClassOpKey, rationalTyConKey,
73 fromIntClassOpKey, fromIntegerClassOpKey, Unique
75 import Maybes ( expectJust )
76 import Util ( thenCmp, zipWithEqual, mapAccumL )
80 %************************************************************************
82 \subsection[Inst-collections]{LIE: a collection of Insts}
84 %************************************************************************
87 type LIE s = Bag (Inst s)
89 isEmptyLIE = isEmptyBag
91 unitLIE inst = unitBag inst
92 mkLIE insts = listToBag insts
93 plusLIE lie1 lie2 = lie1 `unionBags` lie2
94 consLIE inst lie = inst `consBag` lie
95 plusLIEs lies = unionManyBags lies
97 zonkLIE :: LIE s -> NF_TcM s (LIE s)
98 zonkLIE lie = mapBagNF_Tc zonkInst lie
100 pprInsts :: [Inst s] -> SDoc
101 pprInsts insts = parens (hsep (punctuate comma (map pprInst insts)))
105 = vcat (map go insts)
107 go inst = quotes (ppr inst) <+> pprOrigin inst
110 %************************************************************************
112 \subsection[Inst-types]{@Inst@ types}
114 %************************************************************************
116 An @Inst@ is either a dictionary, an instance of an overloaded
117 literal, or an instance of an overloaded value. We call the latter a
118 ``method'' even though it may not correspond to a class operation.
119 For example, we might have an instance of the @double@ function at
120 type Int, represented by
122 Method 34 doubleId [Int] origin
128 Class -- The type of the dict is (c ts), where
129 [TcType s] -- c is the class and ts the types;
136 (TcIdOcc s) -- The overloaded function
137 -- This function will be a global, local, or ClassOpId;
138 -- inside instance decls (only) it can also be an InstId!
139 -- The id needn't be completely polymorphic.
140 -- You'll probably find its name (for documentation purposes)
141 -- inside the InstOrigin
143 [TcType s] -- The types to which its polymorphic tyvars
144 -- should be instantiated.
145 -- These types must saturate the Id's foralls.
147 (TcThetaType s) -- The (types of the) dictionaries to which the function
148 -- must be applied to get the method
150 (TcTauType s) -- The type of the method
155 -- INVARIANT: in (Method u f tys theta tau loc)
156 -- type of (f tys dicts(from theta)) = tau
161 (TcType s) -- The type at which the literal is used
162 (InstOrigin s) -- Always a literal; but more convenient to carry this around
166 = OverloadedIntegral Integer -- The number
167 | OverloadedFractional Rational -- The number
172 @Insts@ are ordered by their class/type info, rather than by their
173 unique. This allows the context-reduction mechanism to use standard finite
174 maps to do their stuff.
177 instance Ord (Inst s) where
180 instance Eq (Inst s) where
181 (==) i1 i2 = case i1 `cmpInst` i2 of
185 cmpInst (Dict _ clas1 tys1 _ _) (Dict _ clas2 tys2 _ _)
186 = (clas1 `compare` clas2) `thenCmp` (tys1 `compare` tys2)
187 cmpInst (Dict _ _ _ _ _) other
191 cmpInst (Method _ _ _ _ _ _ _) (Dict _ _ _ _ _)
193 cmpInst (Method _ id1 tys1 _ _ _ _) (Method _ id2 tys2 _ _ _ _)
194 = (id1 `compare` id2) `thenCmp` (tys1 `compare` tys2)
195 cmpInst (Method _ _ _ _ _ _ _) other
198 cmpInst (LitInst _ lit1 ty1 _ _) (LitInst _ lit2 ty2 _ _)
199 = (lit1 `cmpOverLit` lit2) `thenCmp` (ty1 `compare` ty2)
200 cmpInst (LitInst _ _ _ _ _) other
203 cmpOverLit (OverloadedIntegral i1) (OverloadedIntegral i2) = i1 `compare` i2
204 cmpOverLit (OverloadedFractional f1) (OverloadedFractional f2) = f1 `compare` f2
205 cmpOverLit (OverloadedIntegral _) (OverloadedFractional _) = LT
206 cmpOverLit (OverloadedFractional _) (OverloadedIntegral _) = GT
213 instOrigin (Dict u clas tys origin loc) = origin
214 instOrigin (Method u clas ty _ _ origin loc) = origin
215 instOrigin (LitInst u lit ty origin loc) = origin
217 instLoc (Dict u clas tys origin loc) = loc
218 instLoc (Method u clas ty _ _ origin loc) = loc
219 instLoc (LitInst u lit ty origin loc) = loc
221 getDictClassTys (Dict u clas tys _ _) = (clas, tys)
223 tyVarsOfInst :: Inst s -> TcTyVarSet s
224 tyVarsOfInst (Dict _ _ tys _ _) = tyVarsOfTypes tys
225 tyVarsOfInst (Method _ id tys _ _ _ _) = tyVarsOfTypes tys `unionVarSet` tcIdTyVars id
226 -- The id might not be a RealId; in the case of
227 -- locally-overloaded class methods, for example
228 tyVarsOfInst (LitInst _ _ ty _ _) = tyVarsOfType ty
234 isDict :: Inst s -> Bool
235 isDict (Dict _ _ _ _ _) = True
238 isMethodFor :: TcIdSet s -> Inst s -> Bool
239 isMethodFor ids (Method uniq (TcId id) tys _ _ orig loc)
240 = id `elemVarSet` ids
244 isTyVarDict :: Inst s -> Bool
245 isTyVarDict (Dict _ _ tys _ _) = all isTyVarTy tys
246 isTyVarDict other = False
248 isStdClassTyVarDict (Dict _ clas [ty] _ _) = isStandardClass clas && isTyVarTy ty
249 isStdClassTyVarDict other = False
252 Two predicates which deal with the case where class constraints don't
253 necessarily result in bindings. The first tells whether an @Inst@
254 must be witnessed by an actual binding; the second tells whether an
255 @Inst@ can be generalised over.
258 instBindingRequired :: Inst s -> Bool
259 instBindingRequired (Dict _ clas _ _ _) = not (isNoDictClass clas)
260 instBindingRequired other = True
262 instCanBeGeneralised :: Inst s -> Bool
263 instCanBeGeneralised (Dict _ clas _ _ _) = not (isCcallishClass clas)
264 instCanBeGeneralised other = True
272 newDicts :: InstOrigin s
274 -> NF_TcM s (LIE s, [TcIdOcc s])
276 = tcGetSrcLoc `thenNF_Tc` \ loc ->
277 newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, ids) ->
278 returnNF_Tc (listToBag dicts, ids)
280 -- Local function, similar to newDicts,
281 -- but with slightly different interface
282 newDictsAtLoc :: InstOrigin s
285 -> NF_TcM s ([Inst s], [TcIdOcc s])
286 newDictsAtLoc orig loc theta =
287 tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
289 mk_dict u (clas, tys) = Dict u clas tys orig loc
290 dicts = zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta
292 returnNF_Tc (dicts, map instToId dicts)
294 newDictFromOld :: Inst s -> Class -> [TcType s] -> NF_TcM s (Inst s)
295 newDictFromOld (Dict _ _ _ orig loc) clas tys
296 = tcGetUnique `thenNF_Tc` \ uniq ->
297 returnNF_Tc (Dict uniq clas tys orig loc)
300 newMethod :: InstOrigin s
303 -> NF_TcM s (LIE s, TcIdOcc s)
304 newMethod orig id tys
305 = -- Get the Id type and instantiate it at the specified types
308 (tyvars, rho) = splitForAllTys (idType id)
310 ASSERT( length tyvars == length tys)
311 returnNF_Tc (substFlexiTy (zipVarEnv tyvars tys) rho)
314 (tyvars, rho) = splitForAllTys (idType id)
316 returnNF_Tc (substTy (zipVarEnv tyvars tys) rho)
317 ) `thenNF_Tc` \ rho_ty ->
319 (theta, tau) = splitRhoTy rho_ty
321 newMethodWithGivenTy orig id tys theta tau `thenNF_Tc` \ meth_inst ->
322 returnNF_Tc (unitLIE meth_inst, instToId meth_inst)
325 newMethodWithGivenTy orig id tys theta tau
326 = tcGetSrcLoc `thenNF_Tc` \ loc ->
327 tcGetUnique `thenNF_Tc` \ new_uniq ->
329 meth_inst = Method new_uniq id tys theta tau orig loc
331 returnNF_Tc meth_inst
333 newMethodAtLoc :: InstOrigin s -> SrcLoc
335 -> NF_TcM s (Inst s, TcIdOcc s)
336 newMethodAtLoc orig loc real_id tys -- Local function, similar to newMethod but with
337 -- slightly different interface
338 = -- Get the Id type and instantiate it at the specified types
339 tcGetUnique `thenNF_Tc` \ new_uniq ->
341 (tyvars,rho) = splitForAllTys (idType real_id)
342 rho_ty = ASSERT( length tyvars == length tys )
343 substFlexiTy (zipVarEnv tyvars tys) rho
344 (theta, tau) = splitRhoTy rho_ty
345 meth_inst = Method new_uniq (RealId real_id) tys theta tau orig loc
347 returnNF_Tc (meth_inst, instToId meth_inst)
350 In newOverloadedLit we convert directly to an Int or Integer if we
351 know that's what we want. This may save some time, by not
352 temporarily generating overloaded literals, but it won't catch all
353 cases (the rest are caught in lookupInst).
356 newOverloadedLit :: InstOrigin s
359 -> NF_TcM s (TcExpr s, LIE s)
360 newOverloadedLit orig (OverloadedIntegral i) ty
361 | isIntTy ty && inIntRange i -- Short cut for Int
362 = returnNF_Tc (int_lit, emptyLIE)
364 | isIntegerTy ty -- Short cut for Integer
365 = returnNF_Tc (integer_lit, emptyLIE)
368 intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
369 integer_lit = HsLitOut (HsInt i) integerTy
370 int_lit = HsCon intDataCon [] [intprim_lit]
372 newOverloadedLit orig lit ty -- The general case
373 = tcGetSrcLoc `thenNF_Tc` \ loc ->
374 tcGetUnique `thenNF_Tc` \ new_uniq ->
376 lit_inst = LitInst new_uniq lit ty orig loc
378 returnNF_Tc (HsVar (instToId lit_inst), unitLIE lit_inst)
383 instToId :: Inst s -> TcIdOcc s
384 instToId inst = TcId (instToIdBndr inst)
386 instToIdBndr :: Inst s -> TcIdBndr s
387 instToIdBndr (Dict u clas ty orig loc)
388 = mkUserLocal occ u (mkDictTy clas ty)
390 occ = VarOcc (SLIT("d.") _APPEND_ (occNameString (getOccName clas)))
392 instToIdBndr (Method u id tys theta tau orig loc)
393 = mkUserLocal (getOccName id) u tau
395 instToIdBndr (LitInst u list ty orig loc)
402 Zonking makes sure that the instance types are fully zonked,
403 but doesn't do the same for the Id in a Method. There's no
404 need, and it's a lot of extra work.
407 zonkInst :: Inst s -> NF_TcM s (Inst s)
408 zonkInst (Dict u clas tys orig loc)
409 = zonkTcTypes tys `thenNF_Tc` \ new_tys ->
410 returnNF_Tc (Dict u clas new_tys orig loc)
412 zonkInst (Method u id tys theta tau orig loc)
413 = zonkTcId id `thenNF_Tc` \ new_id ->
414 -- Essential to zonk the id in case it's a local variable
415 zonkTcTypes tys `thenNF_Tc` \ new_tys ->
416 zonkTcThetaType theta `thenNF_Tc` \ new_theta ->
417 zonkTcType tau `thenNF_Tc` \ new_tau ->
418 returnNF_Tc (Method u new_id new_tys new_theta new_tau orig loc)
420 zonkInst (LitInst u lit ty orig loc)
421 = zonkTcType ty `thenNF_Tc` \ new_ty ->
422 returnNF_Tc (LitInst u lit new_ty orig loc)
428 ToDo: improve these pretty-printing things. The ``origin'' is really only
429 relevant in error messages.
432 instance Outputable (Inst s) where
433 ppr inst = pprInst inst
435 pprInst (LitInst u lit ty orig loc)
437 OverloadedIntegral i -> integer i
438 OverloadedFractional f -> rational f,
443 pprInst (Dict u clas tys orig loc) = pprConstraint clas tys <+> show_uniq u
445 pprInst (Method u id tys _ _ orig loc)
446 = hsep [ppr id, ptext SLIT("at"),
447 brackets (interppSP tys),
450 tidyInst :: TidyTypeEnv s -> Inst s -> (TidyTypeEnv s, Inst s)
451 tidyInst env (LitInst u lit ty orig loc)
452 = (env', LitInst u lit ty' orig loc)
454 (env', ty') = tidyType env ty
456 tidyInst env (Dict u clas tys orig loc)
457 = (env', Dict u clas tys' orig loc)
459 (env', tys') = tidyTypes env tys
461 tidyInst env (Method u id tys theta tau orig loc)
462 = (env', Method u id tys' theta tau orig loc)
463 -- Leave theta, tau alone cos we don't print them
465 (env', tys') = tidyTypes env tys
467 tidyInsts env insts = mapAccumL tidyInst env insts
469 show_uniq u = ifPprDebug (text "{-" <> ppr u <> text "-}")
473 %************************************************************************
475 \subsection[InstEnv-types]{Type declarations}
477 %************************************************************************
480 type InstanceMapper = Class -> ClassInstEnv
483 A @ClassInstEnv@ lives inside a class, and identifies all the instances
484 of that class. The @Id@ inside a ClassInstEnv mapping is the dfun for
487 There is an important consistency constraint between the @MatchEnv@s
488 in and the dfun @Id@s inside them: the free type variables of the
489 @Type@ key in the @MatchEnv@ must be a subset of the universally-quantified
490 type variables of the dfun. Thus, the @ClassInstEnv@ for @Eq@ might
491 contain the following entry:
493 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
495 The "a" in the pattern must be one of the forall'd variables in
499 data LookupInstResult s
501 | SimpleInst (TcExpr s) -- Just a variable, type application, or literal
502 | GenInst [Inst s] (TcExpr s) -- The expression and its needed insts
505 -> NF_TcM s (LookupInstResult s)
509 lookupInst dict@(Dict _ clas tys orig loc)
510 = case lookupSpecEnv (ppr clas) (classInstEnv clas) tys of
514 (tyvars, rho) = splitForAllTys (idType dfun_id)
515 ty_args = map (expectJust "Inst" . lookupVarEnv tenv) tyvars
516 -- tenv should bind all the tyvars
517 dfun_rho = substFlexiTy tenv rho
518 (theta, tau) = splitRhoTy dfun_rho
519 ty_app = mkHsTyApp (HsVar (RealId dfun_id)) ty_args
522 returnNF_Tc (SimpleInst ty_app)
524 newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
526 rhs = mkHsDictApp ty_app dict_ids
528 returnNF_Tc (GenInst dicts rhs)
530 Nothing -> returnNF_Tc NoInstance
534 lookupInst inst@(Method _ id tys theta _ orig loc)
535 = newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
536 returnNF_Tc (GenInst dicts (mkHsDictApp (mkHsTyApp (HsVar id) tys) dict_ids))
540 lookupInst inst@(LitInst u (OverloadedIntegral i) ty orig loc)
541 | isIntTy ty && in_int_range -- Short cut for Int
542 = returnNF_Tc (GenInst [] int_lit)
543 -- GenInst, not SimpleInst, because int_lit is actually a constructor application
545 | isIntegerTy ty -- Short cut for Integer
546 = returnNF_Tc (GenInst [] integer_lit)
548 | in_int_range -- It's overloaded but small enough to fit into an Int
549 = tcLookupGlobalValueByKey fromIntClassOpKey `thenNF_Tc` \ from_int ->
550 newMethodAtLoc orig loc from_int [ty] `thenNF_Tc` \ (method_inst, method_id) ->
551 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) int_lit))
553 | otherwise -- Alas, it is overloaded and a big literal!
554 = tcLookupGlobalValueByKey fromIntegerClassOpKey `thenNF_Tc` \ from_integer ->
555 newMethodAtLoc orig loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
556 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) integer_lit))
558 in_int_range = inIntRange i
559 intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
560 integer_lit = HsLitOut (HsInt i) integerTy
561 int_lit = HsCon intDataCon [] [intprim_lit]
563 -- similar idea for overloaded floating point literals: if the literal is
564 -- *definitely* a float or a double, generate the real thing here.
565 -- This is essential (see nofib/spectral/nucleic).
567 lookupInst inst@(LitInst u (OverloadedFractional f) ty orig loc)
568 | isFloatTy ty = returnNF_Tc (GenInst [] float_lit)
569 | isDoubleTy ty = returnNF_Tc (GenInst [] double_lit)
572 = tcLookupGlobalValueByKey fromRationalClassOpKey `thenNF_Tc` \ from_rational ->
574 -- The type Rational isn't wired in so we have to conjure it up
575 tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon ->
577 rational_ty = mkSynTy rational_tycon []
578 rational_lit = HsLitOut (HsFrac f) rational_ty
580 newMethodAtLoc orig loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
581 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) rational_lit))
584 floatprim_lit = HsLitOut (HsFloatPrim f) floatPrimTy
585 float_lit = HsCon floatDataCon [] [floatprim_lit]
586 doubleprim_lit = HsLitOut (HsDoublePrim f) doublePrimTy
587 double_lit = HsCon doubleDataCon [] [doubleprim_lit]
591 There is a second, simpler interface, when you want an instance of a
592 class at a given nullary type constructor. It just returns the
593 appropriate dictionary if it exists. It is used only when resolving
594 ambiguous dictionaries.
597 lookupSimpleInst :: ClassInstEnv
599 -> [Type] -- Look up (c,t)
600 -> NF_TcM s (Maybe ThetaType) -- Here are the needed (c,t)s
602 lookupSimpleInst class_inst_env clas tys
603 = case lookupSpecEnv (ppr clas) class_inst_env tys of
604 Nothing -> returnNF_Tc Nothing
607 -> returnNF_Tc (Just (substFlexiTheta tenv theta))
609 (_, theta, _) = splitSigmaTy (idType dfun)
614 %************************************************************************
616 \subsection[Inst-origin]{The @InstOrigin@ type}
618 %************************************************************************
620 The @InstOrigin@ type gives information about where a dictionary came from.
621 This is important for decent error message reporting because dictionaries
622 don't appear in the original source code. Doubtless this type will evolve...
626 = OccurrenceOf (TcIdOcc s) -- Occurrence of an overloaded identifier
627 | OccurrenceOfCon Id -- Occurrence of a data constructor
631 | DataDeclOrigin -- Typechecking a data declaration
633 | InstanceDeclOrigin -- Typechecking an instance decl
635 | LiteralOrigin HsLit -- Occurrence of a literal
637 | PatOrigin RenamedPat
639 | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc
641 | SignatureOrigin -- A dict created from a type signature
642 | Rank2Origin -- A dict created when typechecking the argument
643 -- of a rank-2 typed function
645 | DoOrigin -- The monad for a do expression
647 | ClassDeclOrigin -- Manufactured during a class decl
649 | InstanceSpecOrigin Class -- in a SPECIALIZE instance pragma
652 -- When specialising instances the instance info attached to
653 -- each class is not yet ready, so we record it inside the
654 -- origin information. This is a bit of a hack, but it works
655 -- fine. (Patrick is to blame [WDP].)
657 | ValSpecOrigin Name -- in a SPECIALIZE pragma for a value
659 -- Argument or result of a ccall
660 -- Dictionaries with this origin aren't actually mentioned in the
661 -- translated term, and so need not be bound. Nor should they
662 -- be abstracted over.
664 | CCallOrigin String -- CCall label
665 (Maybe RenamedHsExpr) -- Nothing if it's the result
666 -- Just arg, for an argument
668 | LitLitOrigin String -- the litlit
670 | UnknownOrigin -- Help! I give up...
674 pprOrigin :: Inst s -> SDoc
676 = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
678 (orig, locn) = case inst of
679 Dict _ _ _ orig loc -> (orig,loc)
680 Method _ _ _ _ _ orig loc -> (orig,loc)
681 LitInst _ _ _ orig loc -> (orig,loc)
683 pp_orig (OccurrenceOf id)
684 = hsep [ptext SLIT("use of"), quotes (ppr id)]
685 pp_orig (OccurrenceOfCon id)
686 = hsep [ptext SLIT("use of"), quotes (ppr id)]
687 pp_orig (LiteralOrigin lit)
688 = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
689 pp_orig (PatOrigin pat)
690 = hsep [ptext SLIT("the pattern"), quotes (ppr pat)]
691 pp_orig (InstanceDeclOrigin)
692 = ptext SLIT("an instance declaration")
693 pp_orig (ArithSeqOrigin seq)
694 = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
695 pp_orig (SignatureOrigin)
696 = ptext SLIT("a type signature")
697 pp_orig (Rank2Origin)
698 = ptext SLIT("a function with an overloaded argument type")
700 = ptext SLIT("a do statement")
701 pp_orig (ClassDeclOrigin)
702 = ptext SLIT("a class declaration")
703 pp_orig (InstanceSpecOrigin clas ty)
704 = hsep [text "a SPECIALIZE instance pragma; class",
705 quotes (ppr clas), text "type:", ppr ty]
706 pp_orig (ValSpecOrigin name)
707 = hsep [ptext SLIT("a SPECIALIZE user-pragma for"), quotes (ppr name)]
708 pp_orig (CCallOrigin clabel Nothing{-ccall result-})
709 = hsep [ptext SLIT("the result of the _ccall_ to"), quotes (text clabel)]
710 pp_orig (CCallOrigin clabel (Just arg_expr))
711 = hsep [ptext SLIT("an argument in the _ccall_ to"), quotes (text clabel) <> comma,
712 text "namely", quotes (ppr arg_expr)]
713 pp_orig (LitLitOrigin s)
714 = hsep [ptext SLIT("the ``literal-literal''"), quotes (text s)]
715 pp_orig (UnknownOrigin)
716 = ptext SLIT("...oops -- I don't know where the overloading came from!")