[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / ghc / compiler / main / MkIface.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1995
3 %
4 \section[MkIface]{Print an interface for a module}
5
6 \begin{code}
7 #include "HsVersions.h"
8
9 module MkIface (
10         mkInterface,
11
12         -- and to make the interface self-sufficient...
13         Bag, CE(..), GlobalSwitch, FixityDecl, Id,
14         Name, PrettyRep, StgBinding, TCE(..), UniqFM, InstInfo
15     ) where
16
17 IMPORT_Trace            -- ToDo: rm (debugging)
18
19 import AbsPrel          ( mkLiftTy, pRELUDE_CORE, pRELUDE_BUILTIN )
20 import AbsSyn           ( FixityDecl(..), RenamedFixityDecl(..), MonoBinds,
21                           RenamedMonoBinds(..), Name, RenamedPat(..), Sig
22                         )
23 import AbsUniType
24 import Bag
25 import CE
26 import CmdLineOpts      -- ( GlobalSwitch(..) )
27 import FiniteMap
28 import Id
29 import IdInfo           -- plenty from here
30 import Maybes           ( catMaybes, Maybe(..) )
31 import Outputable
32 import Pretty
33 import StgSyn
34 import TCE
35 import TcInstDcls       ( InstInfo(..) )
36 import Util
37 \end{code}
38
39 %************************************************************************
40 %*                                                                      *
41 \subsection[main-MkIface]{Main routine for making interfaces}
42 %*                                                                      *
43 %************************************************************************
44
45 Misc points:
46 \begin{enumerate}
47 \item
48 We get the general what-to-export information from the ``environments''
49 produced by the typechecker (the \tr{[RenamedFixityDecl]} through
50 \tr{Bag InstInfo} arguments).
51
52 \item
53 {\em However:} Whereas (for example) an \tr{InstInfo} will have
54 \tr{Ids} in it that identify the constant methods for that instance,
55 those particular \tr{Ids} {\em do not have} the best @IdInfos@!!!
56 Those @IdInfos@ were figured out long after the \tr{InstInfo} was
57 created.
58
59 That's why we actually look at the final \tr{PlainStgBindings} that go
60 into the code-generator: they have the best @IdInfos@ on them.
61 Whenever, we are about to print info about an @Id@, we look in the
62 Ids-from-STG-bindings list to see if we have an ``equivalent'' @Id@
63 with presumably-better @IdInfo@.
64
65 \item
66 We play this same game whether for values, classes (for their
67 method-selectors and default-methods), or instances (for their
68 @DictFunIds@ or constant-methods).
69
70 Of course, for imported things, what we got from the typechecker is
71 all we're gonna get.
72
73 \item
74 We {\em sort} things in the interface into some ``canonical'' order;
75 otherwise, with heavily-recursive modules, you can have (unchanged)
76 information ``move around'' in the interface file---deeply unfriendly
77 to \tr{make}.
78 \end{enumerate}
79
80 \begin{code}
81 mkInterface :: (GlobalSwitch -> Bool)
82             -> FAST_STRING
83             -> (FAST_STRING -> Bool,  -- is something in export list, explicitly?
84                 FAST_STRING -> Bool)  -- is a module among the "dotdot" exported modules?
85             -> IdEnv UnfoldingDetails
86             -> FiniteMap TyCon [[Maybe UniType]]
87             -> ([RenamedFixityDecl],  -- interface info from the typecheck
88                 [Id],
89                 CE,
90                 TCE,
91                 Bag InstInfo)
92             -> [PlainStgBinding]
93             -> Pretty
94
95 mkInterface sw_chkr modname export_list_fns inline_env tycon_specs
96             (fixity_decls, global_ids, ce, tce, inst_infos)
97             stg_binds
98   = let
99         -- first, gather up the things we want to export:
100
101         exported_tycons  = [ tc | tc <- rngTCE tce,
102                            isExported tc,
103                            is_exportable_tycon_or_class sw_chkr export_list_fns tc ]
104         exported_classes = [  c |  c <- rngCE  ce,
105                            isExported  c,
106                            is_exportable_tycon_or_class sw_chkr export_list_fns  c ]
107         exported_inst_infos = [ i | i <- bagToList inst_infos,
108                            is_exported_inst_info sw_chkr export_list_fns i ]
109         exported_vals
110           = [ v | v <- global_ids,
111               isExported v && not (isDataCon v) && not (isClassOpId v) ]
112
113         -- We also have to worry about TyCons/Classes that are
114         -- *mentioned* in exported things (e.g., values' types or
115         -- instances), so that we can be sure to do an import decl for
116         -- them, for original-naming purposes:
117
118         (mentioned_tycons, mentioned_classes)
119           = foldr ( \ (tcs1, cls1) (tcs2, cls2)
120                       -> (tcs1 `unionBags` tcs2, cls1 `unionBags` cls2) )
121                   (emptyBag, emptyBag)
122                   (map getMentionedTyConsAndClassesFromClass exported_classes  ++ 
123                    map getMentionedTyConsAndClassesFromTyCon exported_tycons   ++
124                    map getMentionedTyConsAndClassesFromId    exported_vals     ++
125                    map getMentionedTyConsAndClassesFromInstInfo exported_inst_infos)
126
127         mentionable_classes
128           = filter (is_mentionable sw_chkr) (bagToList mentioned_classes)
129         mentionable_tycons
130           = [ tc | tc <- bagToList mentioned_tycons,
131                    is_mentionable sw_chkr tc,
132                    not (isPrimTyCon tc) ]
133
134         nondup_mentioned_tycons  = fst (removeDups cmpTyCon mentionable_tycons)
135         nondup_mentioned_classes = fst (removeDups cmpClass mentionable_classes)
136
137         -- Next: as discussed in the notes, we want the top-level
138         -- Ids straight from the final STG code, so we can use
139         -- their IdInfos to print pragmas; we slurp them out here,
140         -- then pass them to the printing functions, which may
141         -- use them.
142
143         better_ids = collectExportedStgBinders stg_binds
144
145         -- Make a lookup function for convenient access:
146
147         better_id_fn i
148           = if not (isLocallyDefined i)
149             then i  -- can't be among our "better_ids"
150             else
151                let
152                    eq_fn = if isTopLevId i -- can't trust uniqs
153                            then (\ x y -> getOrigName x == getOrigName y)
154                            else eqId
155                in
156                case [ x | x <- better_ids, x `eq_fn` i ] of
157                  []  -> pprPanic "better_id_fn:" (ppr PprShowAll i)
158                         i
159                  [x] -> x
160                  _   -> panic "better_id_fn"
161
162         -- Finally, we sort everything lexically, so that we always
163         -- get the same interface from the same information:
164
165         sorted_mentioned_tycons  = sortLt ltLexical nondup_mentioned_tycons
166         sorted_mentioned_classes = sortLt ltLexical nondup_mentioned_classes
167
168         sorted_tycons     = sortLt ltLexical exported_tycons
169         sorted_classes    = sortLt ltLexical exported_classes
170         sorted_vals       = sortLt ltLexical exported_vals
171         sorted_inst_infos = sortLt lt_lexical_inst_info exported_inst_infos
172     in
173     if (any_purely_local sorted_tycons sorted_classes sorted_vals) then
174         -- this will be less of a HACK when we teach
175         -- mkInterface to do I/O (WDP 94/10)
176         error "Can't produce interface file because of errors!\n"
177     else
178 --  trace ("mkIface:Ids:"++(ppShow 80 (ppr PprDebug global_ids))) (
179     ppAboves
180        [ppPStr SLIT("{-# GHC_PRAGMA INTERFACE VERSION 5 #-}"),
181         ppCat [ppPStr SLIT("interface"), ppPStr modname, ppPStr SLIT("where")],
182
183         do_import_decls sw_chkr modname
184                 sorted_vals sorted_mentioned_classes sorted_mentioned_tycons,
185                 -- Mustn't give the data constructors to do_import_decls,
186                 -- because they aren't explicitly imported; their tycon is.
187                 -- ToDo: modify if we ever add renaming properly.
188
189         ppAboves (map (do_fixity sw_chkr)                             fixity_decls),
190         ppAboves (map (pprIfaceClass sw_chkr better_id_fn inline_env) sorted_classes),
191         ppAboves (map (do_tycon    sw_chkr tycon_specs)               sorted_tycons),
192         ppAboves (map (do_value    sw_chkr better_id_fn inline_env)   sorted_vals),
193         ppAboves (map (do_instance sw_chkr better_id_fn inline_env)   sorted_inst_infos),
194
195         ppChar '\n'
196        ]
197 --  )
198   where
199     any_purely_local tycons classes vals
200       =  any bad_tc tycons || any bad_cl classes || any bad_id vals
201       where
202         bad_cl cl
203           = case (maybePurelyLocalClass cl) of
204               Nothing -> False
205               Just xs -> naughty_trace cl xs
206
207         bad_id id
208           = case (maybePurelyLocalType (getIdUniType id)) of
209               Nothing -> False
210               Just xs -> naughty_trace id xs
211
212         bad_tc tc
213           = case (maybePurelyLocalTyCon tc) of
214               Nothing -> False
215               Just xs -> if exported_abs then False else naughty_trace tc xs
216           where
217             exported_abs = case (getExportFlag tc) of { ExportAbs -> True; _ -> False }
218
219         naughty_trace x things
220           = pprTrace "Can't export -- `"
221                 (ppBesides [ppr PprForUser x, ppStr "' mentions purely local things: ",
222                         ppInterleave pp'SP things])
223                 True
224 \end{code}
225
226 %************************************************************************
227 %*                                                                      *
228 \subsection[imports-MkIface]{Generating `import' declarations in an interface}
229 %*                                                                      *
230 %************************************************************************
231
232 Not handling renaming yet (ToDo)
233
234 We gather up lots of (module, name) pairs for which we might print an
235 import declaration.  We sort them, for the usual canonicalisation
236 reasons.  NB: We {\em assume} the lists passed in don't have duplicates in
237 them!  expect).
238
239 All rather horribly turgid (WDP).
240
241 \begin{code}
242 do_import_decls
243         :: (GlobalSwitch -> Bool)
244         -> FAST_STRING
245         -> [Id] -> [Class] -> [TyCon]
246         -> Pretty
247
248 do_import_decls sw_chkr mod_name vals classes tycons
249   = let
250         -- Conjure up (module, name, maybe_renaming) triples for all
251         -- the potentially import-decls things:
252
253         vals_names, classes_names, tycons_names :: [(FAST_STRING, FAST_STRING, [Maybe FAST_STRING])]
254         vals_names      = map get_val_triple   vals
255         classes_names   = map get_class_triple classes
256         tycons_names    = map get_tycon_triple tycons
257
258         -- sort the (module, name, renaming) triples and chop
259         -- them into per-module groups:
260
261         ie_list = sortLt lt (tycons_names ++ classes_names ++ vals_names)
262
263         per_module_groups = runs same_module ie_list
264     in
265     ppAboves (map print_a_decl per_module_groups)
266   where
267     lt, same_module :: (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
268                     -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING]) -> Bool 
269
270     lt (m1, ie1, _) (m2, ie2, _)
271       = case _CMP_STRING_ m1 m2 of { LT_ -> True; EQ_ -> ie1 < ie2; GT__ -> False }
272
273     same_module (m1, _, _) (m2, _, _) = m1 == m2
274    
275     compiling_the_prelude = sw_chkr CompilingPrelude
276
277     print_a_decl :: [(FAST_STRING, FAST_STRING, [Maybe FAST_STRING])] -> Pretty
278     {-
279         Obviously, if the module in question is this one,
280         don't print an import declaration.
281
282         If it's a Prelude* module, we don't print the TyCons/
283         Classes, because the compiler supposedly knows about
284         them already (and they are PreludeCore things anyway).
285
286         But if we are compiling a Prelude module, then we
287         try to do it as "normally" as possible.
288     -}
289     print_a_decl (ielist@((m,_,_) : _))
290       |  m == mod_name 
291       || (not compiling_the_prelude &&
292           (m == pRELUDE_CORE || m == pRELUDE_BUILTIN))
293       = ppNil
294
295       | otherwise
296       = ppBesides [ppPStr SLIT("import "), ppPStr m, ppLparen, 
297                    ppIntersperse pp'SP{-'-} (map pp_str [n | (_,n,_) <- ielist]),
298                    ppRparen,
299                    case (grab_non_Nothings [rns | (_,_,rns) <- ielist]) of
300                      []        -> ppNil
301                      renamings -> pp_renamings renamings
302                   ]
303       where
304         isnt_tycon_ish :: FAST_STRING -> Bool
305         isnt_tycon_ish str = not (isConop str)
306
307         grab_non_Nothings :: [[Maybe FAST_STRING]] -> [FAST_STRING]
308
309         grab_non_Nothings rns = catMaybes (concat rns)
310
311         pp_str :: FAST_STRING -> Pretty
312         pp_str pstr
313           = if isAvarop pstr then ppStr ("("++str++")") else ppPStr pstr
314           where
315             str = _UNPK_ pstr
316
317         pp_renamings strs
318           = ppBesides [ ppPStr SLIT(" renaming "), ppLparen, ppIntersperse pp'SP{-'-} (map ppPStr strs), ppRparen ]
319 \end{code}
320
321 Most of the huff and puff here is to ferret out renaming strings.
322
323 \begin{code}
324 get_val_triple   :: Id    -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
325 get_class_triple :: Class -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
326 get_tycon_triple :: TyCon -> (FAST_STRING, FAST_STRING, [Maybe FAST_STRING])
327
328 get_val_triple id
329   = case (generic_triple id) of { (a,b,rn) ->
330     (a,b,[rn]) }
331
332 get_class_triple clas
333   = case (generic_triple clas) of { (orig_mod, orig_nm, clas_rn) ->
334     let
335         nm_to_print = case (getExportFlag clas) of
336                         ExportAll   -> orig_nm _APPEND_ SLIT("(..)") -- nothing like a good HACK!
337                         ExportAbs   -> orig_nm
338                         NotExported -> orig_nm
339
340 -- Ops don't have renaming info (bug) ToDo
341 --      ops         = getClassOps clas
342 --      ops_rns     = [ rn | (_,_,rn) <- map generic_triple ops ]
343     in
344     (orig_mod, nm_to_print, [clas_rn]) }
345
346 get_tycon_triple tycon
347   = case (generic_triple tycon) of { (orig_mod, orig_nm, tycon_rn) ->
348     let
349         nm_to_print = case (getExportFlag tycon) of
350                         ExportAll   -> orig_nm _APPEND_ SLIT("(..)") -- nothing like a good HACK!
351                         ExportAbs   -> orig_nm
352                         NotExported -> orig_nm
353
354         cons        = getTyConDataCons tycon
355         cons_rns    = [ rn | (_,_,rn) <- map generic_triple cons ]
356     in
357     (orig_mod, nm_to_print, tycon_rn : cons_rns) }
358
359 generic_triple thing
360   = case (getOrigName       thing) of { (orig_mod, orig_nm) ->
361     case (getOccurrenceName thing) of { occur_name ->
362     (orig_mod, orig_nm,
363      if orig_nm == occur_name
364      then Nothing
365      else Just (orig_nm _APPEND_ SLIT(" to ") _APPEND_ occur_name)
366     )}}
367 \end{code}
368
369 %************************************************************************
370 %*                                                                      *
371 \subsection[fixities-MkIface]{Generating fixity declarations in an interface}
372 %*                                                                      *
373 %************************************************************************
374
375
376 \begin{code}
377 do_fixity :: (GlobalSwitch -> Bool) -> RenamedFixityDecl -> Pretty
378
379 do_fixity sw_chkr fixity_decl
380   = case (getExportFlag (get_name fixity_decl)) of
381       ExportAll -> ppr (PprInterface sw_chkr) fixity_decl
382       _         -> ppNil
383   where
384      get_name (InfixL n _) = n
385      get_name (InfixR n _) = n
386      get_name (InfixN n _) = n
387 \end{code}
388
389 %************************************************************************
390 %*                                                                      *
391 \subsection[tycons-MkIface]{Generating tycon declarations in an interface}
392 %*                                                                      *
393 %************************************************************************
394
395 \begin{code}
396 do_tycon :: (GlobalSwitch -> Bool) -> FiniteMap TyCon [[Maybe UniType]] -> TyCon -> Pretty
397
398 do_tycon sw_chkr tycon_specs_map tycon
399   = pprTyCon (PprInterface sw_chkr) tycon tycon_specs
400   where
401     tycon_specs = lookupWithDefaultFM tycon_specs_map [] tycon 
402 \end{code}
403
404 %************************************************************************
405 %*                                                                      *
406 \subsection[values-MkIface]{Generating a value's signature in an interface}
407 %*                                                                      *
408 %************************************************************************
409
410 \begin{code}
411 do_value :: (GlobalSwitch -> Bool)
412          -> (Id -> Id)
413          -> IdEnv UnfoldingDetails
414          -> Id
415          -> Pretty
416
417 do_value sw_chkr better_id_fn inline_env val
418   = let
419         sty         = PprInterface sw_chkr
420         better_val  = better_id_fn val
421         name_str    = getOccurrenceName better_val -- NB: not orig name!
422
423         id_info     = getIdInfo better_val
424
425         val_ty      = let 
426                          orig_ty  = getIdUniType val
427                          final_ty = getIdUniType better_val
428                       in
429 --                    ASSERT (orig_ty == final_ty || mkLiftTy orig_ty == final_ty)
430                       ASSERT (if (orig_ty == final_ty || mkLiftTy orig_ty == final_ty) then True else pprTrace "do_value:" (ppCat [ppr PprDebug val, ppr PprDebug better_val]) False)
431                       orig_ty
432
433         -- Note: We export the type of the original val
434         -- The type of an unboxed val will have been *lifted* by the desugarer
435         -- In this case we export an unlifted type, but id_info which assumes
436         --   a lifted Id i.e. extracted from better_val (above)
437         -- The importing module must lift the Id before using the imported id_info
438
439         pp_id_info
440           = if sw_chkr OmitInterfacePragmas
441             || boringIdInfo id_info
442             then ppNil
443             else ppCat [ppPStr SLIT("\t{-# GHC_PRAGMA"),
444                         ppIdInfo sty better_val True{-specs, absolutely-}
445                             better_id_fn inline_env id_info,
446                         ppPStr SLIT("#-}")]
447     in
448     ppAbove (ppCat [ppr_non_op name_str,
449                     ppPStr SLIT("::"), pprUniType sty val_ty])
450             pp_id_info
451
452 -- sadly duplicates Outputable.pprNonOp (ToDo)
453
454 ppr_non_op str
455   = if isAvarop str -- NOT NEEDED: || isAconop
456     then ppBesides [ppLparen, ppPStr str, ppRparen]
457     else ppPStr str
458 \end{code}
459
460 %************************************************************************
461 %*                                                                      *
462 \subsection[instances-MkIface]{Generating instance declarations in an interface}
463 %*                                                                      *
464 %************************************************************************
465
466 The types of ``dictionary functions'' (dfuns) have just the required
467 info for instance declarations in interfaces.  However, the dfuns that
468 GHC really uses have {\em extra} dictionaries passed to them (for
469 efficiency).  When we print interfaces, we want to omit that
470 dictionary information.  (It can be reconsituted on the other end,
471 from instance and class decls).
472
473 \begin{code}
474 do_instance :: (GlobalSwitch -> Bool)
475             -> (Id -> Id)
476             -> IdEnv UnfoldingDetails
477             -> InstInfo
478             -> Pretty
479
480 do_instance sw_chkr better_id_fn inline_env
481     (InstInfo clas tv_tmpls ty inst_decl_theta dfun_theta dfun_id constm_ids _ from_here modname _ _)
482   = let
483         sty = PprInterface sw_chkr
484
485         better_dfun      = better_id_fn dfun_id
486         better_dfun_info = getIdInfo better_dfun
487         better_constms   = map better_id_fn constm_ids
488
489         class_op_strs = map getClassOpString (getClassOps clas)
490
491         pragma_begin
492           = ppCat [ppPStr SLIT("\t{-# GHC_PRAGMA"), pp_modname, ppPStr SLIT("{-dfun-}"),
493                    ppIdInfo sty better_dfun False{-NO specs-}
494                     better_id_fn inline_env better_dfun_info]
495
496         pragma_end = ppPStr SLIT("#-}")
497
498         pp_modname = if _NULL_ modname
499                      then ppNil
500                      else ppCat [ppStr "_M_", ppPStr modname]
501
502         name_pragma_pairs
503           = pp_the_list [ ppCat [ppChar '\t', ppr_non_op op, ppEquals,
504                                 ppIdInfo sty constm True{-YES, specs-}
505                                   better_id_fn inline_env
506                                   (getIdInfo constm)]
507                         | (op, constm) <- class_op_strs `zip` better_constms ]
508
509 #ifdef DEBUG
510         pp_the_list [] = panic "MkIface: no class_ops or better_constms?"
511 #endif
512         pp_the_list [p]    = p
513         pp_the_list (p:ps) = ppAbove (ppBeside p ppComma) (pp_the_list ps)
514
515         real_stuff 
516           = ppCat [ppPStr SLIT("instance"),
517                    ppr sty (mkSigmaTy tv_tmpls inst_decl_theta (mkDictTy clas ty))]
518     in
519     if sw_chkr OmitInterfacePragmas
520     || boringIdInfo better_dfun_info
521     then real_stuff
522     else ppAbove real_stuff
523           ({-ppNest 8 -} -- ppNest does nothing
524              if null better_constms
525              then ppCat [pragma_begin, pragma_end]
526              else ppAbove pragma_begin (ppCat [name_pragma_pairs, pragma_end])
527             -- ToDo: specialised instances
528           )
529 \end{code}
530
531 %************************************************************************
532 %*                                                                      *
533 \subsection[utils-InstInfos]{Utility functions for @InstInfos@}
534 %*                                                                      *
535 %************************************************************************
536
537 ToDo: perhaps move.
538
539 Classes/TyCons are ``known,'' more-or-less.  Prelude TyCons are
540 ``completely'' known---they don't need to be mentioned in interfaces.
541 Classes usually don't need to be mentioned in interfaces, but if we're
542 compiling the prelude, then we treat them without special favours.
543 \begin{code}
544 is_exportable_tycon_or_class sw_chkr export_list_fns tc
545   = if not (fromPreludeCore tc) then
546         True
547     else
548         in_export_list_or_among_dotdot_modules
549             (sw_chkr CompilingPrelude) -- ignore M.. stuff if compiling prelude
550             export_list_fns tc
551
552 in_export_list_or_among_dotdot_modules ignore_Mdotdots (in_export_list, among_dotdot_modules) tc
553   = if in_export_list (getOccurrenceName tc) then
554         True
555     else
556 --      pprTrace "in_export:" (ppAbove (ppr PprDebug ignore_Mdotdots) (ppPStr (getOccurrenceName tc))) (
557     if ignore_Mdotdots then
558         False
559     else
560         any among_dotdot_modules (getInformingModules tc)
561 --  )
562
563 is_mentionable sw_chkr tc
564   = not (from_PreludeCore_or_Builtin tc) || (sw_chkr CompilingPrelude)
565   where
566     from_PreludeCore_or_Builtin thing
567       = let
568             mod_name = fst (getOrigName thing)
569         in
570         mod_name == pRELUDE_CORE || mod_name == pRELUDE_BUILTIN
571
572 is_exported_inst_info sw_chkr export_list_fns
573         (InstInfo clas _ ty _ _ _ _ _ from_here _ _ _)
574   = let
575         is_fun_tycon = isFunType ty
576
577         seems_exported = instanceIsExported clas ty from_here
578
579         (tycon, _, _) = getUniDataTyCon ty
580     in
581     if (sw_chkr OmitReexportedInstances && not from_here) then
582         False -- Flag says to violate Haskell rules, blatantly
583
584     else if not (sw_chkr CompilingPrelude)
585          || not (is_fun_tycon || fromPreludeCore tycon)
586          || not (fromPreludeCore clas) then
587         seems_exported -- take what we got
588
589     else -- compiling Prelude & tycon/class are Prelude things...
590         from_here
591         || in_export_list_or_among_dotdot_modules True{-ignore M..s-} export_list_fns clas
592         || (not is_fun_tycon
593             && in_export_list_or_among_dotdot_modules True{-ignore M..s-} export_list_fns tycon)
594 \end{code}
595
596 \begin{code}
597 lt_lexical_inst_info (InstInfo _ _ _ _ _ dfun1 _ _ _ _ _ _) (InstInfo _ _ _ _ _ dfun2 _ _ _ _ _ _)
598   = ltLexical dfun1 dfun2
599 \end{code}
600
601 \begin{code}
602 getMentionedTyConsAndClassesFromInstInfo (InstInfo clas _ ty _ dfun_theta _ _ _ _ _ _ _)
603   = case (getMentionedTyConsAndClassesFromUniType ty) of { (ts, cs) ->
604     case [ c | (c, _) <- dfun_theta ]                 of { theta_classes ->
605     (ts, (cs `unionBags` listToBag theta_classes) `snocBag` clas)
606     }}
607 \end{code}