2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Inst]{The @Inst@ type: dictionaries or method instances}
8 LIE, emptyLIE, unitLIE, plusLIE, consLIE, zonkLIE, plusLIEs, mkLIE,
9 pprInsts, pprInstsInFull,
11 Inst, OverloadedLit(..), pprInst,
15 newDictFromOld, newDicts, newDictsAtLoc,
16 newMethod, newMethodWithGivenTy, newOverloadedLit,
18 tyVarsOfInst, instLoc, getDictClassTys,
20 lookupInst, lookupSimpleInst, LookupInstResult(..),
22 isDict, isTyVarDict, isStdClassTyVarDict, isMethodFor,
23 instBindingRequired, instCanBeGeneralised,
27 InstOrigin(..), pprOrigin
30 #include "HsVersions.h"
32 import CmdLineOpts ( opt_AllowOverlappingInstances )
33 import HsSyn ( HsLit(..), HsExpr(..), MonoBinds )
34 import RnHsSyn ( RenamedArithSeqInfo, RenamedHsExpr )
35 import TcHsSyn ( TcExpr, TcIdOcc(..), TcIdBndr,
36 mkHsTyApp, mkHsDictApp, tcIdTyVars, zonkTcId
39 import TcEnv ( tcLookupGlobalValueByKey, tcLookupTyConByKey )
40 import TcType ( TcThetaType,
41 TcType, TcTauType, TcMaybe, TcTyVarSet,
42 tcInstType, zonkTcType, zonkTcTypes, tcSplitForAllTy,
45 import Bag ( emptyBag, unitBag, unionBags, unionManyBags,
46 listToBag, consBag, Bag )
47 import Class ( classInstEnv,
50 import MkId ( mkUserLocal, mkSysLocal )
51 import Id ( Id, idType, mkId,
52 GenIdSet, elementOfIdSet
54 import PrelInfo ( isStandardClass, isCcallishClass, isNoDictClass )
55 import Name ( OccName(..), Name, occNameString, getOccName )
56 import PprType ( TyCon, pprConstraint )
57 import SpecEnv ( SpecEnv, lookupSpecEnv )
58 import SrcLoc ( SrcLoc )
59 import Type ( Type, ThetaType, instantiateTy, instantiateThetaTy,
60 isTyVarTy, mkDictTy, splitForAllTys, splitSigmaTy,
61 splitRhoTy, tyVarsOfType, tyVarsOfTypes,
64 import TyVar ( zipTyVarEnv, lookupTyVarEnv, unionTyVarSets )
65 import TysPrim ( intPrimTy, floatPrimTy, doublePrimTy )
66 import TysWiredIn ( intDataCon, integerTy, isIntTy, isIntegerTy, inIntRange,
67 floatDataCon, isFloatTy,
68 doubleDataCon, isDoubleTy )
69 import Unique ( fromRationalClassOpKey, rationalTyConKey,
70 fromIntClassOpKey, fromIntegerClassOpKey, Unique
72 import Maybes ( MaybeErr, expectJust )
73 import Util ( thenCmp, zipWithEqual )
77 %************************************************************************
79 \subsection[Inst-collections]{LIE: a collection of Insts}
81 %************************************************************************
84 type LIE s = Bag (Inst s)
87 unitLIE inst = unitBag inst
88 mkLIE insts = listToBag insts
89 plusLIE lie1 lie2 = lie1 `unionBags` lie2
90 consLIE inst lie = inst `consBag` lie
91 plusLIEs lies = unionManyBags lies
93 zonkLIE :: LIE s -> NF_TcM s (LIE s)
94 zonkLIE lie = mapBagNF_Tc zonkInst lie
96 pprInsts :: [Inst s] -> SDoc
97 pprInsts insts = parens (hsep (punctuate comma (map pprInst insts)))
101 = vcat (map go insts)
103 go inst = quotes (ppr inst) <+> pprOrigin inst
106 %************************************************************************
108 \subsection[Inst-types]{@Inst@ types}
110 %************************************************************************
112 An @Inst@ is either a dictionary, an instance of an overloaded
113 literal, or an instance of an overloaded value. We call the latter a
114 ``method'' even though it may not correspond to a class operation.
115 For example, we might have an instance of the @double@ function at
116 type Int, represented by
118 Method 34 doubleId [Int] origin
124 Class -- The type of the dict is (c ts), where
125 [TcType s] -- c is the class and ts the types;
132 (TcIdOcc s) -- The overloaded function
133 -- This function will be a global, local, or ClassOpId;
134 -- inside instance decls (only) it can also be an InstId!
135 -- The id needn't be completely polymorphic.
136 -- You'll probably find its name (for documentation purposes)
137 -- inside the InstOrigin
139 [TcType s] -- The types to which its polymorphic tyvars
140 -- should be instantiated.
141 -- These types must saturate the Id's foralls.
143 (TcThetaType s) -- The (types of the) dictionaries to which the function
144 -- must be applied to get the method
146 (TcTauType s) -- The type of the method
151 -- INVARIANT: in (Method u f tys theta tau loc)
152 -- type of (f tys dicts(from theta)) = tau
157 (TcType s) -- The type at which the literal is used
158 (InstOrigin s) -- Always a literal; but more convenient to carry this around
162 = OverloadedIntegral Integer -- The number
163 | OverloadedFractional Rational -- The number
168 @Insts@ are ordered by their class/type info, rather than by their
169 unique. This allows the context-reduction mechanism to use standard finite
170 maps to do their stuff.
173 instance Ord (Inst s) where
176 instance Eq (Inst s) where
177 (==) i1 i2 = case i1 `cmpInst` i2 of
181 cmpInst (Dict _ clas1 tys1 _ _) (Dict _ clas2 tys2 _ _)
182 = (clas1 `compare` clas2) `thenCmp` (tys1 `compare` tys2)
183 cmpInst (Dict _ _ _ _ _) other
187 cmpInst (Method _ _ _ _ _ _ _) (Dict _ _ _ _ _)
189 cmpInst (Method _ id1 tys1 _ _ _ _) (Method _ id2 tys2 _ _ _ _)
190 = (id1 `compare` id2) `thenCmp` (tys1 `compare` tys2)
191 cmpInst (Method _ _ _ _ _ _ _) other
194 cmpInst (LitInst _ lit1 ty1 _ _) (LitInst _ lit2 ty2 _ _)
195 = (lit1 `cmpOverLit` lit2) `thenCmp` (ty1 `compare` ty2)
196 cmpInst (LitInst _ _ _ _ _) other
199 cmpOverLit (OverloadedIntegral i1) (OverloadedIntegral i2) = i1 `compare` i2
200 cmpOverLit (OverloadedFractional f1) (OverloadedFractional f2) = f1 `compare` f2
201 cmpOverLit (OverloadedIntegral _) (OverloadedFractional _) = LT
202 cmpOverLit (OverloadedFractional _) (OverloadedIntegral _) = GT
209 instOrigin (Dict u clas tys origin loc) = origin
210 instOrigin (Method u clas ty _ _ origin loc) = origin
211 instOrigin (LitInst u lit ty origin loc) = origin
213 instLoc (Dict u clas tys origin loc) = loc
214 instLoc (Method u clas ty _ _ origin loc) = loc
215 instLoc (LitInst u lit ty origin loc) = loc
217 getDictClassTys (Dict u clas tys _ _) = (clas, tys)
219 tyVarsOfInst :: Inst s -> TcTyVarSet s
220 tyVarsOfInst (Dict _ _ tys _ _) = tyVarsOfTypes tys
221 tyVarsOfInst (Method _ id tys _ _ _ _) = tyVarsOfTypes tys `unionTyVarSets` tcIdTyVars id
222 -- The id might not be a RealId; in the case of
223 -- locally-overloaded class methods, for example
224 tyVarsOfInst (LitInst _ _ ty _ _) = tyVarsOfType ty
230 isDict :: Inst s -> Bool
231 isDict (Dict _ _ _ _ _) = True
234 isMethodFor :: GenIdSet (TcType s) -> Inst s -> Bool
235 isMethodFor ids (Method uniq (TcId id) tys _ _ orig loc)
236 = id `elementOfIdSet` ids
240 isTyVarDict :: Inst s -> Bool
241 isTyVarDict (Dict _ _ tys _ _) = all isTyVarTy tys
242 isTyVarDict other = False
244 isStdClassTyVarDict (Dict _ clas [ty] _ _) = isStandardClass clas && isTyVarTy ty
245 isStdClassTyVarDict other = False
248 Two predicates which deal with the case where class constraints don't
249 necessarily result in bindings. The first tells whether an @Inst@
250 must be witnessed by an actual binding; the second tells whether an
251 @Inst@ can be generalised over.
254 instBindingRequired :: Inst s -> Bool
255 instBindingRequired (Dict _ clas _ _ _) = not (isNoDictClass clas)
256 instBindingRequired other = True
258 instCanBeGeneralised :: Inst s -> Bool
259 instCanBeGeneralised (Dict _ clas _ _ _) = not (isCcallishClass clas)
260 instCanBeGeneralised other = True
268 newDicts :: InstOrigin s
270 -> NF_TcM s (LIE s, [TcIdOcc s])
272 = tcGetSrcLoc `thenNF_Tc` \ loc ->
273 newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, ids) ->
274 returnNF_Tc (listToBag dicts, ids)
276 -- Local function, similar to newDicts,
277 -- but with slightly different interface
278 newDictsAtLoc :: InstOrigin s
281 -> NF_TcM s ([Inst s], [TcIdOcc s])
282 newDictsAtLoc orig loc theta =
283 tcGetUniques (length theta) `thenNF_Tc` \ new_uniqs ->
285 mk_dict u (clas, tys) = Dict u clas tys orig loc
286 dicts = zipWithEqual "newDictsAtLoc" mk_dict new_uniqs theta
288 returnNF_Tc (dicts, map instToId dicts)
290 newDictFromOld :: Inst s -> Class -> [TcType s] -> NF_TcM s (Inst s)
291 newDictFromOld (Dict _ _ _ orig loc) clas tys
292 = tcGetUnique `thenNF_Tc` \ uniq ->
293 returnNF_Tc (Dict uniq clas tys orig loc)
296 newMethod :: InstOrigin s
299 -> NF_TcM s (LIE s, TcIdOcc s)
300 newMethod orig id tys
301 = -- Get the Id type and instantiate it at the specified types
303 RealId id -> let (tyvars, rho) = splitForAllTys (idType id)
305 ASSERT( length tyvars == length tys)
306 tcInstType (zipTyVarEnv tyvars tys) rho
308 TcId id -> tcSplitForAllTy (idType id) `thenNF_Tc` \ (tyvars, rho) ->
309 returnNF_Tc (instantiateTy (zipTyVarEnv tyvars tys) rho)
310 ) `thenNF_Tc` \ rho_ty ->
312 (theta, tau) = splitRhoTy rho_ty
314 -- Our friend does the rest
315 newMethodWithGivenTy orig id tys theta tau
318 newMethodWithGivenTy orig id tys theta tau
319 = tcGetSrcLoc `thenNF_Tc` \ loc ->
320 tcGetUnique `thenNF_Tc` \ new_uniq ->
322 meth_inst = Method new_uniq id tys theta tau orig loc
324 returnNF_Tc (unitLIE meth_inst, instToId meth_inst)
326 newMethodAtLoc :: InstOrigin s -> SrcLoc
328 -> NF_TcM s (Inst s, TcIdOcc s)
329 newMethodAtLoc orig loc real_id tys -- Local function, similar to newMethod but with
330 -- slightly different interface
331 = -- Get the Id type and instantiate it at the specified types
333 (tyvars,rho) = splitForAllTys (idType real_id)
335 tcInstType (zipTyVarEnv tyvars tys) rho `thenNF_Tc` \ rho_ty ->
336 tcGetUnique `thenNF_Tc` \ new_uniq ->
338 (theta, tau) = splitRhoTy rho_ty
339 meth_inst = Method new_uniq (RealId real_id) tys theta tau orig loc
341 returnNF_Tc (meth_inst, instToId meth_inst)
344 In newOverloadedLit we convert directly to an Int or Integer if we
345 know that's what we want. This may save some time, by not
346 temporarily generating overloaded literals, but it won't catch all
347 cases (the rest are caught in lookupInst).
350 newOverloadedLit :: InstOrigin s
353 -> NF_TcM s (TcExpr s, LIE s)
354 newOverloadedLit orig (OverloadedIntegral i) ty
355 | isIntTy ty && inIntRange i -- Short cut for Int
356 = returnNF_Tc (int_lit, emptyLIE)
358 | isIntegerTy ty -- Short cut for Integer
359 = returnNF_Tc (integer_lit, emptyLIE)
362 intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
363 integer_lit = HsLitOut (HsInt i) integerTy
364 int_lit = HsApp (HsVar (RealId intDataCon)) intprim_lit
366 newOverloadedLit orig lit ty -- The general case
367 = tcGetSrcLoc `thenNF_Tc` \ loc ->
368 tcGetUnique `thenNF_Tc` \ new_uniq ->
370 lit_inst = LitInst new_uniq lit ty orig loc
372 returnNF_Tc (HsVar (instToId lit_inst), unitLIE lit_inst)
377 instToId :: Inst s -> TcIdOcc s
378 instToId (Dict u clas ty orig loc)
379 = TcId (mkUserLocal occ u (mkDictTy clas ty) loc)
381 occ = VarOcc (SLIT("d.") _APPEND_ (occNameString (getOccName clas)))
383 instToId (Method u id tys theta tau orig loc)
384 = TcId (mkUserLocal (getOccName id) u tau loc)
386 instToId (LitInst u list ty orig loc)
387 = TcId (mkSysLocal SLIT("lit") u ty loc)
393 Zonking makes sure that the instance types are fully zonked,
394 but doesn't do the same for the Id in a Method. There's no
395 need, and it's a lot of extra work.
398 zonkInst :: Inst s -> NF_TcM s (Inst s)
399 zonkInst (Dict u clas tys orig loc)
400 = zonkTcTypes tys `thenNF_Tc` \ new_tys ->
401 returnNF_Tc (Dict u clas new_tys orig loc)
403 zonkInst (Method u id tys theta tau orig loc)
404 = zonkTcId id `thenNF_Tc` \ new_id ->
405 -- Essential to zonk the id in case it's a local variable
406 zonkTcTypes tys `thenNF_Tc` \ new_tys ->
407 zonkTcThetaType theta `thenNF_Tc` \ new_theta ->
408 zonkTcType tau `thenNF_Tc` \ new_tau ->
409 returnNF_Tc (Method u new_id new_tys new_theta new_tau orig loc)
411 zonkInst (LitInst u lit ty orig loc)
412 = zonkTcType ty `thenNF_Tc` \ new_ty ->
413 returnNF_Tc (LitInst u lit new_ty orig loc)
419 ToDo: improve these pretty-printing things. The ``origin'' is really only
420 relevant in error messages.
423 instance Outputable (Inst s) where
424 ppr inst = pprInst inst
426 pprInst (LitInst u lit ty orig loc)
428 OverloadedIntegral i -> integer i
429 OverloadedFractional f -> rational f,
434 pprInst (Dict u clas tys orig loc) = pprConstraint clas tys <+> show_uniq u
436 pprInst (Method u id tys _ _ orig loc)
437 = hsep [ppr id, ptext SLIT("at"),
441 show_uniq u = ifPprDebug (text "{-" <> ppr u <> text "-}")
445 %************************************************************************
447 \subsection[InstEnv-types]{Type declarations}
449 %************************************************************************
452 type InstanceMapper = Class -> ClassInstEnv
455 A @ClassInstEnv@ lives inside a class, and identifies all the instances
456 of that class. The @Id@ inside a ClassInstEnv mapping is the dfun for
459 There is an important consistency constraint between the @MatchEnv@s
460 in and the dfun @Id@s inside them: the free type variables of the
461 @Type@ key in the @MatchEnv@ must be a subset of the universally-quantified
462 type variables of the dfun. Thus, the @ClassInstEnv@ for @Eq@ might
463 contain the following entry:
465 [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
467 The "a" in the pattern must be one of the forall'd variables in
471 data LookupInstResult s
473 | SimpleInst (TcExpr s) -- Just a variable, type application, or literal
474 | GenInst [Inst s] (TcExpr s) -- The expression and its needed insts
476 -> NF_TcM s (LookupInstResult s)
480 lookupInst dict@(Dict _ clas tys orig loc)
481 = case lookupSpecEnv (ppr clas) (classInstEnv clas) tys of
485 (tyvars, rho) = splitForAllTys (idType dfun_id)
486 ty_args = map (expectJust "Inst" . lookupTyVarEnv tenv) tyvars
487 -- tenv should bind all the tyvars
489 tcInstType tenv rho `thenNF_Tc` \ dfun_rho ->
491 (theta, tau) = splitRhoTy dfun_rho
492 ty_app = mkHsTyApp (HsVar (RealId dfun_id)) ty_args
495 returnNF_Tc (SimpleInst ty_app)
497 newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
499 rhs = mkHsDictApp ty_app dict_ids
501 returnNF_Tc (GenInst dicts rhs)
503 Nothing -> returnNF_Tc NoInstance
507 lookupInst inst@(Method _ id tys theta _ orig loc)
508 = newDictsAtLoc orig loc theta `thenNF_Tc` \ (dicts, dict_ids) ->
509 returnNF_Tc (GenInst dicts (mkHsDictApp (mkHsTyApp (HsVar id) tys) dict_ids))
513 lookupInst inst@(LitInst u (OverloadedIntegral i) ty orig loc)
514 | isIntTy ty && in_int_range -- Short cut for Int
515 = returnNF_Tc (GenInst [] int_lit)
516 -- GenInst, not SimpleInst, because int_lit is actually a constructor application
518 | isIntegerTy ty -- Short cut for Integer
519 = returnNF_Tc (GenInst [] integer_lit)
521 | in_int_range -- It's overloaded but small enough to fit into an Int
522 = tcLookupGlobalValueByKey fromIntClassOpKey `thenNF_Tc` \ from_int ->
523 newMethodAtLoc orig loc from_int [ty] `thenNF_Tc` \ (method_inst, method_id) ->
524 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) int_lit))
526 | otherwise -- Alas, it is overloaded and a big literal!
527 = tcLookupGlobalValueByKey fromIntegerClassOpKey `thenNF_Tc` \ from_integer ->
528 newMethodAtLoc orig loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) ->
529 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) integer_lit))
531 in_int_range = inIntRange i
532 intprim_lit = HsLitOut (HsIntPrim i) intPrimTy
533 integer_lit = HsLitOut (HsInt i) integerTy
534 int_lit = HsApp (HsVar (RealId intDataCon)) intprim_lit
536 -- similar idea for overloaded floating point literals: if the literal is
537 -- *definitely* a float or a double, generate the real thing here.
538 -- This is essential (see nofib/spectral/nucleic).
540 lookupInst inst@(LitInst u (OverloadedFractional f) ty orig loc)
541 | isFloatTy ty = returnNF_Tc (GenInst [] float_lit)
542 | isDoubleTy ty = returnNF_Tc (GenInst [] double_lit)
545 = tcLookupGlobalValueByKey fromRationalClassOpKey `thenNF_Tc` \ from_rational ->
547 -- The type Rational isn't wired in so we have to conjure it up
548 tcLookupTyConByKey rationalTyConKey `thenNF_Tc` \ rational_tycon ->
550 rational_ty = mkSynTy rational_tycon []
551 rational_lit = HsLitOut (HsFrac f) rational_ty
553 newMethodAtLoc orig loc from_rational [ty] `thenNF_Tc` \ (method_inst, method_id) ->
554 returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) rational_lit))
557 floatprim_lit = HsLitOut (HsFloatPrim f) floatPrimTy
558 float_lit = HsApp (HsVar (RealId floatDataCon)) floatprim_lit
559 doubleprim_lit = HsLitOut (HsDoublePrim f) doublePrimTy
560 double_lit = HsApp (HsVar (RealId doubleDataCon)) doubleprim_lit
564 There is a second, simpler interface, when you want an instance of a
565 class at a given nullary type constructor. It just returns the
566 appropriate dictionary if it exists. It is used only when resolving
567 ambiguous dictionaries.
570 lookupSimpleInst :: ClassInstEnv
572 -> [Type] -- Look up (c,t)
573 -> NF_TcM s (Maybe ThetaType) -- Here are the needed (c,t)s
575 lookupSimpleInst class_inst_env clas tys
576 = case lookupSpecEnv (ppr clas) class_inst_env tys of
577 Nothing -> returnNF_Tc Nothing
580 -> returnNF_Tc (Just (instantiateThetaTy tenv theta))
582 (_, theta, _) = splitSigmaTy (idType dfun)
587 %************************************************************************
589 \subsection[Inst-origin]{The @InstOrigin@ type}
591 %************************************************************************
593 The @InstOrigin@ type gives information about where a dictionary came from.
594 This is important for decent error message reporting because dictionaries
595 don't appear in the original source code. Doubtless this type will evolve...
599 = OccurrenceOf (TcIdOcc s) -- Occurrence of an overloaded identifier
600 | OccurrenceOfCon Id -- Occurrence of a data constructor
604 | DataDeclOrigin -- Typechecking a data declaration
606 | InstanceDeclOrigin -- Typechecking an instance decl
608 | LiteralOrigin HsLit -- Occurrence of a literal
610 | ArithSeqOrigin RenamedArithSeqInfo -- [x..], [x..y] etc
612 | SignatureOrigin -- A dict created from a type signature
613 | Rank2Origin -- A dict created when typechecking the argument
614 -- of a rank-2 typed function
616 | DoOrigin -- The monad for a do expression
618 | ClassDeclOrigin -- Manufactured during a class decl
620 | InstanceSpecOrigin Class -- in a SPECIALIZE instance pragma
623 -- When specialising instances the instance info attached to
624 -- each class is not yet ready, so we record it inside the
625 -- origin information. This is a bit of a hack, but it works
626 -- fine. (Patrick is to blame [WDP].)
628 | ValSpecOrigin Name -- in a SPECIALIZE pragma for a value
630 -- Argument or result of a ccall
631 -- Dictionaries with this origin aren't actually mentioned in the
632 -- translated term, and so need not be bound. Nor should they
633 -- be abstracted over.
635 | CCallOrigin String -- CCall label
636 (Maybe RenamedHsExpr) -- Nothing if it's the result
637 -- Just arg, for an argument
639 | LitLitOrigin String -- the litlit
641 | UnknownOrigin -- Help! I give up...
645 pprOrigin :: Inst s -> SDoc
647 = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
649 (orig, locn) = case inst of
650 Dict _ _ _ orig loc -> (orig,loc)
651 Method _ _ _ _ _ orig loc -> (orig,loc)
652 LitInst _ _ _ orig loc -> (orig,loc)
654 pp_orig (OccurrenceOf id)
655 = hsep [ptext SLIT("use of"), quotes (ppr id)]
656 pp_orig (OccurrenceOfCon id)
657 = hsep [ptext SLIT("use of"), quotes (ppr id)]
658 pp_orig (LiteralOrigin lit)
659 = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
660 pp_orig (InstanceDeclOrigin)
661 = ptext SLIT("an instance declaration")
662 pp_orig (ArithSeqOrigin seq)
663 = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
664 pp_orig (SignatureOrigin)
665 = ptext SLIT("a type signature")
666 pp_orig (Rank2Origin)
667 = ptext SLIT("a function with an overloaded argument type")
669 = ptext SLIT("a do statement")
670 pp_orig (ClassDeclOrigin)
671 = ptext SLIT("a class declaration")
672 pp_orig (InstanceSpecOrigin clas ty)
673 = hsep [text "a SPECIALIZE instance pragma; class",
674 quotes (ppr clas), text "type:", ppr ty]
675 pp_orig (ValSpecOrigin name)
676 = hsep [ptext SLIT("a SPECIALIZE user-pragma for"), quotes (ppr name)]
677 pp_orig (CCallOrigin clabel Nothing{-ccall result-})
678 = hsep [ptext SLIT("the result of the _ccall_ to"), quotes (text clabel)]
679 pp_orig (CCallOrigin clabel (Just arg_expr))
680 = hsep [ptext SLIT("an argument in the _ccall_ to"), quotes (text clabel) <> comma,
681 text "namely", quotes (ppr arg_expr)]
682 pp_orig (LitLitOrigin s)
683 = hsep [ptext SLIT("the ``literal-literal''"), quotes (text s)]
684 pp_orig (UnknownOrigin)
685 = ptext SLIT("...oops -- I don't know where the overloading came from!")